XLS VBA VlookUp с использованием RC от статического до динамического

Question

Я пытаюсь создать MACRO для vlook-up.

У меня 2 листа. Мне удалось заставить его работать с VlookUp hardcoded.

Могу ли я сделать его динамичным?

Вот мой код:

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

изменить ваши в заявлении:

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

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 
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