我最近加入,期待与社区合作!
这是我有史以来的第一个VBA项目。我有一个构建宏的项目,它需要使用几个vlookup公式。该公式在后续选项卡上查找转换。因此,对于选项卡1列1上的值,它在选项卡2上查找;对于选项卡1列2,它在选项卡3上查找,依此类推。
问题在于查找似乎更像是“查找/替换”,而不仅仅是完全匹配的真实查找。下面,到目前为止,我的研究得到了什么。我知道还有很多东西需要学习 - 请帮忙!
谢谢!
'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"
这是FULL宏 - 我认为问题在于查找,但我可能错了!
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