Question

我正在尝试为vlook-up创建一个MACRO。

我有2张。我设法使用VlookUp硬编码。

我可以让它变得动态吗？

这是我的代码：

    Option Explicit

    Sub VlookUp4()

    Dim NrColsOld, NrColsNew As Integer 'Numarul de celule in primul rand, incepand cu A1 sheet "old" si "new"
    Dim FoundOld, FoundNew As Range
    Dim LROld, LRNew As Long
    Dim Cauta As Variant
    'Cauta = InputBox("Filtru dupa ce coloana?")

    Sheets("old").Select
    With ActiveSheet
        NrColsOld = .Cells(1, .Columns.Count).End(xlToLeft).Column ' Calculeaza care e ultima coloana din sheet
    End With
    'Set Found = Rows(1).Find(What:=Cauta, LookIn:=xlValues, lookat:=xlWhole)
    Set FoundOld = Rows(1).Find(What:="Numar", LookIn:=xlValues, lookat:=xlWhole)
    If FoundOld Is Nothing Then Exit Sub
    LROld = Cells(Rows.Count, FoundOld.Column).End(xlUp).Row
    ActiveSheet.Range(Cells(1, 1), Cells(LROld, FoundOld.Column + NrColsOld)).AutoFilter
    Worksheets("old").Range(Cells(1, 1), Cells(LROld, FoundOld.Column + NrColsOld)).Columns.AutoFit
    Range(Cells(1, 1), Cells(LROld, NrColsOld)).Select 'selecteaza celulele ce contin valori
    ActiveWorkbook.Worksheets("old").AutoFilter.Sort.SortFields.Add Key:=Range(Cells(1, FoundOld.Column), Cells(1, FoundOld.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'Range(Cells(1, Found.Column), Cells(1, Found.Column)).Select   'selecteaza doar celula cu numele celulei dupa care facem ordonarea
    With ActiveWorkbook.Worksheets("old").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Sheets("new").Select
    With ActiveSheet
        NrColsNew = .Cells(1, .Columns.Count).End(xlToLeft).Column ' Calculeaza care e ultima coloana din sheet
    End With
    'Set Found = Rows(1).Find(What:=Cauta, LookIn:=xlValues, lookat:=xlWhole)
    Set FoundNew = Rows(1).Find(What:="Numar", LookIn:=xlValues, lookat:=xlWhole)
    If FoundNew Is Nothing Then Exit Sub
    LRNew = Cells(Rows.Count, FoundNew.Column).End(xlUp).Row
    ActiveSheet.Range(Cells(1, 1), Cells(LRNew, FoundNew.Column + NrColsNew)).AutoFilter
    Worksheets("new").Range(Cells(1, 1), Cells(LRNew, FoundNew.Column + NrColsNew)).Columns.AutoFit
    Range(Cells(1, 1), Cells(LRNew, NrColsNew + 1)).Select 'selecteaza celulele ce contin valori + 1 se adauga pentru ca se insereaza o coloana
    ActiveWorkbook.Worksheets("new").AutoFilter.Sort.SortFields.Add Key:=Range(Cells(1, FoundNew.Column), Cells(1, FoundNew.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'Range(Cells(1, Found.Column), Cells(1, Found.Column)).Select   'selecteaza doar celula cu numele celulei dupa care facem ordonarea
    With ActiveWorkbook.Worksheets("new").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    FoundNew.Offset(, 1).EntireColumn.Insert
    Cells(1, FoundNew.Column + 1).Value = "New vs Old"

    Dim unu, doi, trei As Integer
    unu = 1
    doi = 2
    trei = 3

    Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[-1],old!C[-3]:C[-2],2,0)"
    'Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[-unu],old!C[-trei]:C[-doi],2,0)"
'    Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).Select
'    Selection.Copy
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'    Selection.Replace What:="#N/A", Replacement:="Intrari Noi", lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'    ActiveSheet.Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).AutoFilter field:=5, Criteria1:="Intrari Noi"
End Sub

首先我要转换

Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[-1],old!C[-3]:C[-2],2,0)"

到

Dim unu, doi, trei As Integer
    unu = 1
    doi = 2
    trei = 3


   Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[-unu],old!C[-trei]:C[-doi],2,0)"

请有人给我一个提示。

感谢。

Answer 1

将您的into语句更改为：

Dim unu, doi, trei As Integer
    unu = 1
    doi = 2
    trei = 3


   Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[-" & unu & "],old!C[-" & trei & "]:C[-" & doi & "],2,0)"

说明：如果您尝试使用代码，VBA会将unu，doi和trei解释为文字字符串表示，您最终会在您的单元格中显示=VLOOKUP(RC[-unu],old!C[-trei]:C[-dui],2,0)，Excel不知道该怎么做。

当您通过vlookup将它们连接到&字符串时，VBA能够传递变量unu（1），doi（2）的值，trei（3）到vlookup字符串。所以你在你的单元格中得到=VLOOKUP(RC[-1],old!C[-3]:C[-2],2,0)，而Excel可以使用它。

Answer 2

选项明确

Sub VlookUp4（）

Dim NrColsOld, NrColsNew As Integer 'Numarul de celule in primul rand, incepand cu A1 sheet "old" si "new"
Dim FoundOld, FoundNew As Range
Dim LROld, LRNew As Long
Dim Cauta As Variant
Dim Coloana1, Coloana2, Coloana3, Sheet1, Sheet2, Sheet3 As String

Coloana1 = "Numar"
Coloana2 = "Valoare"
Coloana3 = "New vs Old"
Sheet1 = "old"
Sheet2 = "new"
Sheet3 = "new vs old"

'Enter = InputBox("Filtru dupa ce coloana?")

Sheets(Sheet1).Select
With ActiveSheet
    NrColsOld = .Cells(1, .Columns.Count).End(xlToLeft).Column ' Calculeaza care e ultima coloana din sheet
End With
'Set Found = Rows(1).Find(What:=Enter, LookIn:=xlValues, lookat:=xlWhole)
Set FoundOld = Rows(1).Find(What:=Coloana1, LookIn:=xlValues, LookAt:=xlWhole)
If FoundOld Is Nothing Then Exit Sub
LROld = Cells(Rows.Count, FoundOld.Column).End(xlUp).Row

ActiveSheet.Range(Cells(1, 1), Cells(LROld, NrColsOld)).AutoFilter
Worksheets(Sheet1).Range(Cells(1, 1), Cells(LROld, FoundOld.Column + NrColsOld)).Columns.AutoFit
Range(Cells(1, 1), Cells(LROld, NrColsOld)).Select 'selecteaza celulele ce contin valori
ActiveWorkbook.Worksheets(Sheet1).AutoFilter.Sort.SortFields.Add Key:=Range(Cells(1, FoundOld.Column), Cells(1, FoundOld.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'Range(Cells(1, Found.Column), Cells(1, Found.Column)).Select   'selecteaza doar celula cu numele celulei dupa care facem ordonarea
With ActiveWorkbook.Worksheets(Sheet1).AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


Sheets(Sheet2).Select
With ActiveSheet
    NrColsNew = .Cells(1, .Columns.Count).End(xlToLeft).Column ' Calculeaza care e ultima coloana din sheet
End With
'Set Found = Rows(1).Find(What:=Cauta, LookIn:=xlValues, lookat:=xlWhole)
Set FoundNew = Rows(1).Find(What:=Coloana1, LookIn:=xlValues, LookAt:=xlWhole)
If FoundNew Is Nothing Then Exit Sub
LRNew = Cells(Rows.Count, FoundNew.Column).End(xlUp).Row
ActiveSheet.Range(Cells(1, 1), Cells(LRNew, NrColsNew)).AutoFilter
Worksheets(Sheet2).Range(Cells(1, 1), Cells(LRNew, FoundNew.Column + NrColsNew)).Columns.AutoFit
Range(Cells(1, 1), Cells(LRNew, NrColsNew + 1)).Select 'selecteaza celulele ce contin valori + 1 se adauga pentru ca se insereaza o coloana
ActiveWorkbook.Worksheets(Sheet2).AutoFilter.Sort.SortFields.Add Key:=Range(Cells(1, FoundNew.Column), Cells(1, FoundNew.Column)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'Range(Cells(1, Found.Column), Cells(1, Found.Column)).Select   'selecteaza doar celula cu numele celulei dupa care facem ordonarea
With ActiveWorkbook.Worksheets(Sheet2).AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
FoundNew.Offset(, 1).EntireColumn.Insert
Cells(1, FoundNew.Column + 1).Value = Coloana3

Dim resOldx, resNewx, resNewy As Object
Dim CC, GetColumnNumber, GetColumnNumberOldx, GetColumnNumberNewx, GetColumnNumberNewy As Integer

'############################
Set resOldx = Sheets(Sheet1).Cells(1, 1).EntireRow.Find(What:=Coloana1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
If resOldx Is Nothing Then
    GetColumnNumberOldx = 0
Else
    GetColumnNumberOldx = resOldx.Column
End If
'MsgBox ("Numar Old " & GetColumnNumberOldx)

'############################
Set resNewy = Sheets(Sheet2).Cells(1, 1).EntireRow.Find(What:=Coloana1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
If resNewy Is Nothing Then
    GetColumnNumberNewy = 0
Else
    GetColumnNumberNewy = resNewy.Column
End If
'MsgBox ("Numar New " & GetColumnNumberNewy)

'############################
Set resNewx = Sheets(Sheet2).Cells(1, 1).EntireRow.Find(What:=Coloana3, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
If resNewx Is Nothing Then
    GetColumnNumberNewx = 0
Else
    GetColumnNumberNewx = resNewx.Column
End If
'MsgBox ("New vs Old " & GetColumnNumberNewx)

CC = GetColumnNumberNewx


Dim x, y, z As Integer

x = GetColumnNumberNewy - GetColumnNumberNewx
'MsgBox ("x are valoarea " & x)
y = GetColumnNumberOldx - GetColumnNumberNewx
'MsgBox ("y are valoarea " & y)
z = 0
'MsgBox ("z are valoarea " & z)

Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).FormulaR1C1 = "=VLOOKUP(RC[" & x & "],old!C[" & y & "]:C[" & z & "],1,0)"
Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="Intrari Noi", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveSheet.Range(Cells(2, FoundNew.Column + 1), Cells(LRNew, FoundNew.Column + 1)).AutoFilter field:=CC, Criteria1:="Intrari Noi"
Worksheets(Sheet2).Columns.AutoFit

Range("A2").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row, Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
With Selection.Font
    .Color = -16776961
   .TintAndShade = 0
End With

Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row, Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
Selection.Copy
Sheets(Sheet3).Select
ActiveSheet.Paste
Selection.AutoFilter
Worksheets(Sheet3).Columns.AutoFit

End Sub

XLS VBA VlookUp使用RC从静态到动态

2 个答案: