VBA: Hinzufügen von Werten zu einem Array auf der Grundlage einer Bedingung

Question

Stellen Sie sich vor, in Blatt (4) habe ich die folgenden, wobei D und E sind die Spalten und 8 und 9 sind die Zeilennummer.

Daher möchte ich diese Werte mit den Werten der Spalten B und D aus Blatt (1) der gleichen Arbeitsmappe vergleichen. Wenn die Werte gleich sind, dann wird zum Beispiel der I entsprechenden Wert der Spalte G. bringen:

B C G 
13 1 A 5 
14 1 B 6 
15 1 C 7 
16 2 A 8 
17 2 B 9 
18 2 C 10 
19 3 A 11 
20 3 B 12 
21 3 C 13 

I prüft, ob sh4.cells (8, D) = sh1.cells (13, B), und wenn das ist wahr, ich werde überprüfen, ob sh4.cells (9, D) = sh1.cells (13, C). Wenn beide Bedingungen erfüllt sind, bringe ich den Wert der Spalte G, die 5 ist, in das Array ein.

Der Code, den ich geschrieben habe, ist unten und ich zähle mit Ihrer Hilfe, um zu sehen, warum es nicht funktioniert.

Dim d as integer 
d = 0 
Dim c as integer 
c = 1 
Dim refConcentrations as variant 

If sh4.cells(8,3+c) = sh1.cells(13+d,2) Then 
If sh4.cells(9,3+c) = sh1.cells(13+d,3) Then 
    If IsEmpty(refconcentrations) Then 
    ReDim refConcentrations(1 To 1) As Variant 
    refConcentrations(UBound(refConcentrations)) = sh1.cells(13+d,7).value 
    Else 
    ReDim Preserve refConcentrations(1 To UBound(refConcentrations) + 1) as Variant 
    End If 
End If 
End If 

Vielen Dank im Voraus.

Answer 1

Der folgende Code fügt alle "übereinstimmenden" Werte von Blatt (4) und Blatt (1) von Spalte G bis refConcentrations Array hinzu. Der Code erlaubt das mehrfache "Hinzufügen" zum Array im Falle mehrerer Übereinstimmungen in Blatt (1).

-Code

Option Explicit 

Sub MatchSheetsData() 

Dim refConcentrations As Variant 
Dim i As Long, j As Integer, LastRow As Long 
Dim ColSrc As Integer  

' Init array to a very large size on init >> will optimize at the end of the code 
ReDim refConcentrations(1 To 1000) As Variant 

' find last row with data in Column B at Sheet(1) 
With Sheets(1) 
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
End With  
j = 1 ' init array element index 

' looping through column D-E in Sheet(4) 
For ColSrc = 4 To 5   
    For i = 13 To LastRow 
     If Sheets(1).Range("B" & i).Value = Sheets(4).Cells(8, ColSrc).Value Then 
      If Sheets(1).Range("C" & i).Value = Sheets(4).Cells(9, ColSrc).Value Then 
       refConcentrations(j) = Sheets(1).Range("D" & i).Value 
       j = j + 1 
      End If 
     End If 
    Next i 

Next ColSrc 

ReDim Preserve refConcentrations(1 To j - 1) ' <-- resize array to number of elements found 

End Sub