|
▼Hirofumi さん:
>こんな物かな?
>
>Option Explicit
>
>Public Sub Sample()
>
> Dim i As Long
> Dim j As Long
> Dim rngTop As Range
> Dim vntResult As Variant
> Dim rngList As Range
>
> '座標の有る表の左上隅の位置を設定
> Set rngTop = Worksheets("Sheet1").Cells(1, "A")
> '座標の有る表を配列に取得
> vntResult = rngTop.CurrentRegion.Value
>
> '置換する値の有るListの範囲を取得
> With Worksheets("Sheet2")
> Set rngList = Range(.Cells(1, "B"), _
> .Cells(65536, "B").End(xlUp))
> End With
>
> '座標の有る表の値を置換
> For i = 1 To UBound(vntResult, 1)
> For j = 1 To UBound(vntResult, 2)
> vntResult(i, j) _
> = RowSearch(vntResult(i, j), rngList)
> Next j
> Next i
>
> '座標の有る表を書き戻す
> With rngTop
> .Resize(UBound(vntResult, 1), _
> UBound(vntResult, 2)) = vntResult
> End With
>
> Set rngList = Nothing
> Set rngTop = Nothing
>
> Beep
> MsgBox "処理が完了しました"
>
>End Sub
>
>Private Function RowSearch(vntKey As Variant, _
> rngScope As Range) As Variant
>
>' 一覧の探索
>
> Dim vntFound As Variant
>
> '一覧を探索して行位置を取得
> vntFound = Application.Match(vntKey, rngScope, 0)
> 'エラーで無い場合(一覧に値が有る)
> If Not IsError(vntFound) Then
> '取得行の探索列左の値を返す
> RowSearch = rngScope(vntFound).Offset(, -1).Value
> End If
>
>End Function
ありがとうございます。
おかげさまで解決いたしました。
|
|