将string添加到dynamic数组VBA
问题：我正在比较两列名称。 如果主列中的名称与辅助列中的名称匹配，那么我想将匹配的名称添加到string数组中。
函数1：这个布尔函数应该表明是否匹配：
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 函数2：该函数应该将匹配的名称添加到string的dynamic数组中。 在这里我有点卡住，因为我是新的arrays – 任何build议？
Function AddToArray(ys) As String() Dim a() As String Dim size As Integer Dim i As Integer Dim sh As Worksheet Dim rw As Range size = 0 ReDim Preserve a(size) For Each rw In sh.Rows If Match(sh.Cells(rw.Row, 1), s, column) = True Then ?? size = size + 1 End Function
这是一个解决scheme。 我放弃了你的Matchfunction，并用Find函数replace它。
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
额外的评论
无需创build自己的匹配function，因为它已经存在于VBA中：
Application.Match() WorksheetFunction.Match()
正如我上面提到的，你也可以用Find函数来获得同样的结果，因为我更喜欢你可以检查没有匹配的方法（其他方法抛出不太方便的错误）。
最后，我还select将代码重构为一个Sub而不是两个Functions 。 你不会用你的AddToArray函数返回任何东西，这几乎意味着它应该实际上是一个Sub
正如我在这个问题的评论中所说的，在向数组添加任何内容之前，代码中有几个问题会阻止这个工作，但是假设这是由简化代码来提出问题引起的，则应该工作。
您所要问的具体问题是如何在需要时增加其大小的同时填充数组。
要做到这一点，只需做到这一点：
代替：
ReDim Preserve a(size) For Each rw In sh.Rows If Match(sh.Cells(rw.Row, 1), s, column) = True Then
对此重新sorting，使其成为：
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 ....
这可能不是完成这个任务的最好方法，但是这是你要做的。 首先，增加arrays大小每次都会浪费很多时间。 每10或100场比赛，而不是每次增加arrays大小会更好。 我将把这个练习留给你。 然后你可以调整它的大小，最后到你想要的确切大小。