[ChatGPT To VBA] 配列から検索したい配列リストの中を一つづつ検索して、見つかった値と見つからなかった値を空白で代入した二次元配列を返す。

'VBAで二次元配列から検索したい配列リストの中を一つづつ検索して、
'見つかった値と見つからなかった値を空白で代入した二次元配列を返す。
'配列を範囲セルに一気に代入するために返す配列は二次元配列で一列目をスタートに指定している
Function ExtractValues(targetRange As Variant, searchList As Variant) As Variant
    Dim results() As Variant
    ReDim results(1 To UBound(searchList), 1 To 2) ' 結果格納用の配列
'    ReDim results(1 To UBound(searchList), 1) ' 結果格納用配列
    Dim foundValue As Variant
    Dim i As Long, j As Long, k As Long
    
    ' 配列から値を取得
    For k = LBound(searchList) To UBound(searchList)
        foundValue = Empty
        For i = LBound(targetRange) To UBound(targetRange)
            For j = LBound(targetRange, 2) To UBound(targetRange, 2)
                If targetRange(i, j) = searchList(k, 1) Then
                    foundValue = searchList(k, 1)
                    Exit For
                End If
            Next j
            If Not IsEmpty(foundValue) Then Exit For
        Next i
        ' 結果を格納
        results(k, 1) = searchList(k, 1)
        results(k, 1) = IIf(IsEmpty(foundValue), "", foundValue)
    Next k
    
    ' 結果を返す
    ExtractValues = results
End Function

Related Posts