Looping для идентификации пара в моих данных

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 по-прежнему полезны, только вы должны перебрать каждый Area клетки также

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