私のデータでペアを識別するためにループする

Question

私はこの問題があります。私はここに位置して働いているので

を、それぞれの位置はペアで来ます。私は、リスト全体をループし、各位置のペアの値の差を計算したいので（私は損失またはゲインを見つけたい）、別のセルに戻します。ここでは第1の位置の対の差は14688であり、以下は別の位置の対である。私のデータの構造は、空のセルで区切られた空でないセルなので、ここでは素晴らしい人々の助けを借りて、Areaプロパティを使用しました。しかし、私は以下のような連続した空でないセルを持つデータを考慮し、それらをペアにするコードを必要とします。

最初の位置は、行の任意のヘルプ63

Sub main() 
    Dim iPair As Long 
    Dim pairDiff As Variant 


    pairDiff = 1 

    With Worksheets("System 1") 
     With .range("T39", .Cells(.Rows.Count, "T").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through column "T" cells containing numbers from row 63 down to last not empty one 
      iPair = 1 '<--| initialize "pair" counter 
      Do While iPair < .Areas.Count '<--| loop through "pairs" 
       pairDiff = .Areas(iPair + 1).Offset(, 1) + .Areas(iPair).Offset(, 1) 
       .Areas(iPair + 1).Offset(, IIf(pairDiff < 0, 7, 8)) = pairDiff '<--| write "pair" difference in corresponding column "V" (if loss) or "W" (if gain) 
       iPair = iPair + 2 '<--| update "pair" counter by adding two not to mix "pairs" 
      Loop 
     End With 
    End With 
End Sub 

ですか？私が私の質問に特定する必要があるなら、それに応じてそれを編集します。ありがとうございました。

Answer 1

Areas も

ます。Option Explicit

Sub main() 
    Dim ielem As Long 
    Dim pair1stValue As Double, pairDiff As Double 
    Dim area As Range, cell As Range 

    With Worksheets("lossgain") '<-- change "losspair" to your actual worksheet name 
     With .Range("T63", .Cells(.Rows.Count, "T").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through column "T" cells containing numbers from row 63 down to last not empty one 
      For Each area In .Areas 
       For Each cell In area.Cells 
        ielem = ielem + 1 
        If Int(ielem/2) * 2 = ielem Then 
         pairDiff = cell.Offset(, 1) - pair1stValue '<--| calculate the "pair" difference from corresponding column "U" values 
         cell.Offset(, IIf(pairDiff < 0, 2, 3)) = pairDiff '<--| write "pair" difference in corresponding column "V" (if loss) or "W" (if gain) 
        Else 
         pair1stValue = cell.Offset(, 1) 
        End If 
       Next 
      Next 
     End With 
    End With 
End Sub