| |
こんな物かな？
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
