Question

问题：我正在比较两列名称。如果主列中的名称与辅助列中的名称匹配，那么我想将匹配的名称添加到字符串数组中。

功能1：此布尔函数应指示是否存在匹配：

std::make_tuple

功能2：此函数应将匹配的名称添加到动态字符串数组中。在这里，我有点卡住，因为我是阵列的新手 - 任何建议？

Function Match(name As String, s As Worksheet, column As Integer) As Boolean
Dim i As Integer
i = 2
While s.Cells(i, column) <> ""
  If s.Cells(i, column).Value = name Then
        Match = True
  End If
  i = i + 1
Wend
Match = False
End Function

Answer 1

这是一个解决方案。我取消了您的Match功能，并将其替换为Find功能。

Option Explicit

Sub AddToArray()
    Dim primaryColumn As Range, secondaryColumn As Range, matchedRange As Range
    Dim i As Long, currentIndex As Long
    Dim matchingNames As Variant

    With ThisWorkbook.Worksheets("Sheet1")
        Set primaryColumn = .Range("A1:A10")
        Set secondaryColumn = .Range("B1:B10")
    End With

    'Size your array so no dynamic resizing is necessary
    ReDim matchingNames(1 To primaryColumn.Rows.Count)
    currentIndex = 1

    'loop through your primary column 
    'add any values that match to the matchingNames array
    For i = 1 To primaryColumn.Rows.Count
        On Error Resume Next
        Set matchedRange = secondaryColumn.Find(primaryColumn.Cells(i, 1).Value)
        On Error GoTo 0

        If Not matchedRange Is Nothing Then
            matchingNames(currentIndex) = matchedRange.Value
            currentIndex = currentIndex + 1
        End If
    Next i

    'remove unused part of array
    ReDim Preserve matchingNames(1 To currentIndex - 1)

    'matchingNames array now contains just the values you want... use it how you need!
    Debug.Print matchingNames(1)
    Debug.Print matchingNames(2)
    '...etc
End Sub

额外评论

无需创建自己的匹配功能，因为它已存在于VBA中：

Application.Match()
WorksheetFunction.Match()

正如我上面提到的，你也可以使用Find函数获得相同的结果，这是我的偏好，因为我更喜欢检查没有匹配的方法（其他方法抛出不太方便的错误）。

最后，我还选择将您的代码重组为一个Sub而不是两个Functions。您没有使用AddToArray函数返回任何内容，根据定义它实际上应该是Sub

Answer 2

正如我在对该问题的评论中所述，在向数组添加任何内容之前，代码中存在一些问题会阻止其工作，但假设这是由简化代码提出问题引起的，以下应该有效。

您要问的具体问题是如何在需要时增加其大小的同时填充数组。

要做到这一点，只需这样做：

而不是：

ReDim Preserve a(size)
For Each rw In sh.Rows
    If Match(sh.Cells(rw.Row, 1), s, column) = True Then

重新排序，以便：

For Each rw In sh.Rows
    If Match(sh.Cells(rw.Row, 1), s, column) = True Then
         ReDim Preserve a(size) 'increase size of array
         a(size) = sh.Cells(rw.Row,1) 'put value in array
         size = size + 1 'create value for size of next array
    End If
Next rw

....

这可能不是完成此任务的最佳方式，但这是您要求做的。首先，增加阵列大小每次都会浪费很多时间。最好每10或100次匹配增加数组大小，而不是每次都增加。我会把这个练习留给你。然后你可以在最后调整它到你想要的确切大小。

将字符串添加到动态数组VBA

2 个答案: