在VBA中3个vlookups

我最近join，并期待着与社区合作！

这是我的第一个VBA项目。 我有一个项目build立一个macros，它需要使用几个vlookup公式。 公式会在随后的标签上查找翻译。 因此，对于选项卡1列1中的值，它将显示在选项卡2上; 对于选项卡1列2，它在选项卡3上等等。

问题在于查找似乎更像是“查找/replace”，而不是真正的查找。 下面是我的研究到目前为止。 我知道有很多要学习 – 请帮助！

谢谢！

'Insert Crosswalk columns Columns("H:H").Insert Set Rng = Range("H2:H" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=VLOOKUP(RC[-1],Crosswalk_1!C[-7]:C[-6],2,0)" Range("H1").Select ActiveCell.FormulaR1C1 = "Crosswalk_1" Columns("J:J").Insert Set Rng = Range("J2:J" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=VLOOKUP(RC[-1],Crosswalk_2!C[-9]:C[-8],2,0)" Range("J1").Select ActiveCell.FormulaR1C1 = "Crosswalk_2" Columns("K:K").Insert Set Rng = Range("K2:K" & Range("A:A").End(xlDown).Row) 'Rng.FormulaR1C1 = "=VLOOKUP(RC[1],Crosswalk_3!C[-10]:C[-9],2,0)" Range("K1").Select ActiveCell.FormulaR1C1 = "Crosswalk_3" 

这是完整的macros – 我认为这个问题是查找，但我可能是错的！

 Sub MainMacro() If MsgBox("Before starting, ensure Entity ID is ascending", vbYesNo, "Input Required") = vbYes Then MsgBox "Please do not use Excel while this macro is running." Dim Rng As Range 'Insert "Formula" columns Columns("C:C").Insert Set Rng = Range("C2:C" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],1,0)" Range("C1").Select ActiveCell.FormulaR1C1 = "Formula1" Columns("D:D").Insert Set Rng = Range("D2:D" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],1,0)" Range("D1").Select ActiveCell.FormulaR1C1 = "Formula2" Columns("E:E").Insert Set Rng = Range("E2:E" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" Range("E1").Select ActiveCell.FormulaR1C1 = "Concatenate1" 'Insert Crosswalk columns Columns("H:H").Insert Set Rng = Range("H2:H" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=VLOOKUP(RC[-1],Crosswalk_1!C[-7]:C[-6],2,0)" Range("H1").Select ActiveCell.FormulaR1C1 = "Crosswalk_1" Columns("J:J").Insert Set Rng = Range("J2:J" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=VLOOKUP(RC[-1],Crosswalk_2!C[-9]:C[-8],2,0)" Range("J1").Select ActiveCell.FormulaR1C1 = "Crosswalk_2" Columns("K:K").Insert Set Rng = Range("K2:K" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=VLOOKUP(RC[1],Crosswalk_3!C[-10]:C[-9],2,0)" Range("K1").Select ActiveCell.FormulaR1C1 = "Crosswalk_3" 'Copy&Paste Values Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select 'Clean-up & Final Formatting Range("G1").Select Range("G1").Cut Destination:=Range("H1") Range("I1").Select Range("I1").Cut Destination:=Range("J1") Range("L1").Select Range("L1").Cut Destination:=Range("K1") Columns("G:G").Select Selection.Delete Shift:=xlToLeft Columns("H:H").Select Selection.Delete Shift:=xlToLeft Columns("J:J").Select Selection.Delete Shift:=xlToLeft Columns("G:I").Select Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Application.CutCopyMode = False 'Apply Filter to isolate duplicates Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False Range(Selection, Selection.End(xlToRight)).Select Selection.AutoFilter ActiveSheet.Range("$A:$I").AutoFilter Field:=5, Criteria1:=Array( _ "01", "10", "11"), Operator:=xlFilterValues 'Delete dupes Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select ActiveSheet.Range("$A:$L").RemoveDuplicates Columns:=Array(1, 2, 6, 7, 8, 9), Header:=xlYes 'Final De-Dupe Process Columns("C:E").Select Selection.Delete Shift:=xlToLeft Range("A1").Select Columns("C:C").Insert Set Rng = Range("C2:C" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],1,0)" Range("C1").Select ActiveCell.FormulaR1C1 = "Formula1" Columns("D:D").Insert Set Rng = Range("D2:D" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],1,0)" Range("D1").Select ActiveCell.FormulaR1C1 = "Formula2" Columns("E:E").Insert Set Rng = Range("E2:E" & Range("A:A").End(xlDown).Row) Rng.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" Range("E1").Select ActiveCell.FormulaR1C1 = "Duplicate Status" 'Copy&Paste Values Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("C:D").Select Selection.Delete Shift:=xlToLeft Range("C1").Select With Selection.Interior .Pattern = xlSolid .PatternColor = 12632256 .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With 'Replace "01", "10", "11" with "Duplicate" Columns("C:C").Select Selection.Replace What:="10", Replacement:="Duplicate", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="01", Replacement:="Duplicate", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="11", Replacement:="Duplicate", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 'Clear filter Range("C1").Select ActiveWorkbook.Worksheets("Inputdata (3)").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("Inputdata (3)").AutoFilter.Sort.SortFields.Add Key _ :=Range("C1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Inputdata (3)").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Final message for user (manually check for remaining duplicates) Range("A1").Select MsgBox "Macro Complete! Remaining duplicates require manual editing." End If End Sub