VBA:根据条件向数组添加值

时间:2017-01-10 13:27:31

标签: excel vba match dynamic-arrays

想象一下在表(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

提前致谢。

1 个答案:

答案 0 :(得分:0)

下面的代码将添加表格(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