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