他の 2 つのセルの連結値の vlookup に基づいて、1 つのセルに特定の値を返すマクロを作成しました。このマクロは、30 列の場合、1 列おきに実行する必要がある場合があります。30 のバリエーションを入力する必要がないように、これをループできる方法はありますか?
私が参照しているコードのセクションは次のとおりです。
Cells.Select
ActiveWorkbook.Worksheets("Vendor Request").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Vendor Request").Sort.SortFields.Add Key:=Range( _
"F2:F" & LR2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Vendor Request").Sort
.SetRange Range("A1:BK" & LR2)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
If Cells(2, 6).Value <> "" Then
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(""Example: "",IF(ISNA(VLOOKUP(CONCATENATE(RC[-4],""; "",RC[-1]),'Sample Data'!C[-6]:C[-2],5,FALSE)),"""",VLOOKUP(CONCATENATE(RC[-4],""; "",RC[-1]),'Sample Data'!C[-6]:C[-2],5,FALSE)))"
If Cells(3, 6).Value <> "" Then
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G" & Range("F" & Rows.Count).End(xlUp).Row)
Else
End If
Columns("G:G").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
End If
前もって感謝します!
編集:ついに機能しました。これが私が最終的に得たものです:
Cells.Select
ActiveWorkbook.Worksheets("Vendor Request").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Vendor Request").Sort.SortFields.Add Key:=Columns( _
j - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Vendor Request").Sort
.SetRange Range("A1:BK" & LR2)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim LRj As Long
With Sheets("Vendor Request")
LRj = .Cells(.Rows.Count, j - 1).End(xlUp).Row
End With
If Cells(2, j - 1).Value <> "" Then
Cells(2, j).Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(""Example: "",IF(ISNA(VLOOKUP(CONCATENATE(c3,""; "",C[-1]),'Sample Data'!c1:c6,5,FALSE)),"""",VLOOKUP(CONCATENATE(c3,""; "",C[-1]),'Sample Data'!c1:c6,5,FALSE)))"
If Cells(3, j - 1).Value <> "" Then
Cells(2, j).Select
Selection.AutoFill Destination:=Range(Cells(2, j), Cells(LRj, j))
Else
End If
Columns(j).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
End If
Next j