Dynamic Array VBAに文字列を追加

Question

問題：私は2つの列の名前を比較しています。プライマリ列の名前がセカンダリ列の名前と一致する場合は、一致する名前を文字列の配列に追加したいと思います。

機能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：この関数は、文字列の動的配列に一致する名前を追加する必要があります。ここでは、私は配列 - 新しい提案に何か提案がありますか？

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 

Answer 1

ここに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機能で同じ結果を達成することもできます私はあなたが一致しないことを確認できる方法を好むからです（他の方法はあまり便利でないエラーを投げます）。

最後に、Functionsではなく、1つのSubにコードを再構成することも選択しました。あなたは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回ごとに配列のサイズを増やす方がよいでしょう。私はあなたにこの練習を残します。それから、あなたが望む正確なサイズになるようにサイズを変更することができます。