VBA：值添加到基於條件

Question

想象在片的陣列（4）我有以下內容，其中d和E是列和8和9是行號。

D E 
8 1 1 
9 B C 

因此，我想將這些值與來自同一工作簿的工作表（1）中的列B和D的值進行比較。如果這兩個值是相等的，然後我會帶來列G的各值例如：

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 

我將檢查是否sh4.cells（8，d）= sh1.cells（13，B），並且如果該是真的，我會檢查是否sh4.cells（9，D）= sh1.cells（13，C）。如果兩個條件都成立，我將把列G的值爲5並存儲在數組中。

我寫的代碼如下，我和你的幫助計數看到爲什麼它不工作。

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 

在此先感謝。

Answer 1

下面的代碼將添加所有的「匹配」值從片材（4）和片材（1），從G列到refConcentrations陣列。該代碼允許在工作表（1）中存在多個匹配的情況下多次「添加」到數組中。

代碼

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