Looping zu identifizieren Paare in meinen Daten

Question

ich dieses Problem habe:

Da ich mit Positionen, hier zu arbeiten bin, kommt jede Position in einem Paar. Ich möchte die ganze Liste durchschleifen und den Wertunterschied in jedem Positionspaar berechnen (so will ich den Verlust oder die Verstärkung finden) und es in eine andere Zelle zurückgeben. hier ist der Unterschied zwischen dem 1. Positionspaar 14688, das folgende ist ein anderes Positionspaar. Mit der Hilfe von einigen tollen Leuten hier habe ich die Area Eigenschaft verwendet, da die Struktur meiner Daten eine nicht leere Zelle ist, die durch leere Zellen begrenzt ist. Allerdings benötige ich einen Code, der Daten berücksichtigt, die aufeinanderfolgende nichtleere Zellen wie unten haben, und sie trotzdem paaren.

Die erste Position ist in Zeile 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 

Jede Hilfe? Wenn Sie mich brauchen, um mit meiner Frage spezifisch zu sein, werde ich es entsprechend bearbeiten. Danke.

Answer 1

Areas sind immer noch nützlich, nur Sie haben auch durch jede Area Zellen Schleife noch Explicit

Option

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