Question

我有2张excel表，我必须比较一些值，这是很容易的部分。为此，我使用了以下代码：

Dim OldLabel() As String, size As Integer, i As Integer, j As Integer

size = WorksheetFunction.CountA(Worksheets(3).Columns(1))

ReDim OldLabel(size)

j = 1

For i = 7 To size

   If (InStr(Cells(i, 1).Value, "[") > 0) Then
       OldLabel(j) = Cells(i, 1).Value
       j = j + 1
   End If

Next i

Dim NewLabel() As String, newSize As Integer, k As Integer, l As Integer

newSize = WorksheetFunction.CountA(Worksheets(4).Columns(1))

ReDim NewLabel(newSize)

l = 1

For k = 7 To newSize
     If (InStr(Cells(k, 1).Value, "[") > 0) Then
       NewLabel(l) = Cells(k, 1).Value
       l = l + 1
   End If
Next k

之后我必须比较两个数组的值并检查它们是否相同并将它们写入另一个表。我试图遵循代码，但它似乎没有工作。

Dim cont As Integer
cont = 1

For i = 1 To size
    For k = 1 To newSize

        If (OldLabel(i) = NewLabel(k)) Then
            Sheet8.Activate
            Range("A1").Select
            Cells(cont, 1).Value = OldLabel(i)
            cont = cont + 1
        End If

    Next k

Next i

Answer 1

这是我建议使用数据集而不是数组的情况之一：

'Define data collections:
    Dim OldLabel As New Collection: Set OldLabel = New Collection
    Dim NewLabel As New Collection: Set NewLabel = New Collection
'Define data limits:
    Dim OldLimit As Integer
    OldLimit = ThisWorkbook.Sheets("Sheet3").Columns(1).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
    Dim NewLimit As Integer
    NewLimit = ThisWorkbook.Sheets("Sheet4").Columns(1).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
'Define extra variables:
    Dim counter As Integer
    counter = 1
'Fill collections:
    For x = 1 To OldLimit
        If InStr(ThisWorkbook.Sheets("Sheet3").Cells(x, 1).text, "[") > 0 Then
            OldLabel.Add ThisWorkbook.Sheets("Sheet3").Cells(x, 1).text
        End If
    Next x
    For x = 1 To NewLimit
        If InStr(ThisWorkbook.Sheets("Sheet4").Cells(x, 1).text, "[") > 0 Then
            NewLabel.Add ThisWorkbook.Sheets("Sheet4").Cells(x, 1).text
        End If
    Next x
'Writer:
If OldLabel.Count > 0 And NewLabel.Count > 0 Then
    For x = 1 To OldLabel.Count
        For y = 1 To NewLabel.Count
            If OldLabel(x) = NewLabel(y) Then
                ThisWorkbook.Sheets("Sheet8").Cells(counter, 1).FormulaR1C1 = OldLabel(x)
                counter = counter + 1
            End If
        Next y
    Next x
End If

请注意：a）您无需为您的程序激活工作表; b）我将工作表命名并使用该名称来引用它们;由于某些原因，我更喜欢不使用表索引; c）检查你只是将单元格与其中的“[”字符进行比较; d）如果任何数据列为空，则代码将产生错误。

比较VBA中的2个数组并写入另一个工作表

1 个答案: