Добавьте путь к файлу в формулу, которая введена в другую ячейку vlookup - PullRequest
Новая
       7

Добавьте путь к файлу в формулу, которая введена в другую ячейку vlookup

0 голосов
/ 23 января 2020

Как использовать vlookup, когда у меня есть командная кнопка, которая вставляет путь к файлу в ячейку @ Worksheets("sheet1").Cells(5, 4).Value = Get_Path, в то время как другая командная кнопка использует файл по этому пути, упомянутый для формулы vlookup. @ ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Worksheets("sheet1").Cells(5, 4).Value'!C1:C2,2,0)"

полный код приведен ниже. Ваши советы ценны. заранее спасибо. 

Sub currentZOE3()
'declare variable to store path

Dim Get_Path As String

    Dim fileExplorer As FileDialog
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False

    With fileExplorer

If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(3, 4).Value = Get_Path

End With

End Sub
Sub lastweekZOE3()

'declare variable to store path

Dim Get_Path As String

    Dim fileExplorer As FileDialog
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False

    With fileExplorer

If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(5, 4).Value = Get_Path

End With

End Sub

Sub Macro4()
'
' Macro4 Macro
'

'

Dim updWb As Workbook
Dim DSheet As Worksheet
Set updWb = Workbooks.Open(Worksheets("sheet1").Cells(3, 4).Value)
Set DSheet = updWb.Sheets("Sheet1")

Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    Columns("Q:S").Select
    Selection.Insert Shift:=xlToRight
    Range("Q1") = "Concantenate"
    Range("R1") = "Delivery Plan"
    Range("S1") = "Last Week Comments"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-16]&RC[-9]&RC[-7]"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2]," & Worksheets("sheet1").Cells(5, 4).Value & "!C1:C2,2,0)"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFS(RC22=""YBWR"",""What"",ISNUMBER(RC25),""Fully Delivered"",RC19=""Billable Only"",""BILLABLE ONLY"",AND(ISBLANK(RC25),NOT(ISBLANK(RC27))),""Under shipment"",AND(ISBLANK(RC25),ISBLANK(RC27),ISNUMBER(RC14)),""Under packing"",AND(ISBLANK(RC25),ISBLANK(RC27),ISBLANK(RC14)),TEXT(WEEKNUM(RC23),""W00""))"
    Range("P3").Select
    Selection.End(xlDown).Select
    Range("Q8833:S8833").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Cells.Select
    Range("Q8833").Activate
    Selection.Columns.AutoFit

    With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""What"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 12173758
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""Fully Delivered"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5691552
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""under shipment"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 3774674
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""under packing"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 15793920
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

    Sheets(Array("Sheet2", "Sheet3")).Select
    Sheets("Sheet3").Activate
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete

        Range("A1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A1:A8837"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$BE$8837").AutoFilter Field:=1

    'Declare Variables
Dim PSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim pvtfield As PivotField

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet1")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)


'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sold to name")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("PivotTable").PivotFields("Sales Document")
.Orientation = xlRowField
.Position = 2
End With

With ActiveSheet.PivotTables("PivotTable").PivotFields("Customer purchase order number")
.Orientation = xlRowField
.Position = 3
End With

'Insert Column Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Delivery Plan")
.Orientation = xlColumnField
.Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("SO Net value")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = " Sum SO Net value "
End With

'classic and expand/collapse button removal

Range("C7").Select
    With ActiveSheet.PivotTables("PivotTable")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    Range("B4").Select

ActiveSheet.PivotTables("PivotTable").ShowDrillIndicators = False

'Формат Pivot TableActiveSheet.PivotTables ("PivotTable"). ShowTableStyleRowStripes = TrueActiveSheet.PivotTables ("PivotTable"). TableStyle2 = "PivotStyleMedium9"

* 1000 End

Ответы [ 2 ]

0 голосов
/ 23 января 2020

Согласно моему комментарию (что почти правильно) вам понадобятся символы &, чтобы вставить ссылку в вашу формулу. Правильный синтаксис: 

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'" & Worksheets("Sheet1").Cells(5, 4).Text & "'!C1:C2,2,0)"

Обратите внимание, что это все равно приведет к появлению запроса о том, какой лист использовать из указанной вами книги.

0 голосов
/ 23 января 2020

Внешняя ссылка должна состоять из полного имени файла, включая путь, если рабочая книга не открыта. Он должен быть заключен в квадратные скобки и заключен в одинарные кавычки, содержащие имя листа. VLOOKUP(RC[-2],'[My Workbook]Sheet1'!C1:C2,2,0)

Следовательно, это синтаксис для добавления вашей динамической c книги в формулу Vlookup. 

ActiveCell.FormulaR1C1 ="=VLOOKUP(RC[-2], " & "'[" & INDIRECT(ADDRESS(5,4,1,1,"Sheet1")) & "]" & INDIRECT(ADDRESS(5,4,1,1,"Sheet1")) & "'!C1:C2,2,0)"

Извините, я не смог проверить эту формулу, но чувствую себя достаточно уверенно, что это будет работать. Конечно, адрес, который вы указали для путей и имен листов, идентичен и поэтому невозможен. Пожалуйста, измените определение функции АДРЕС, чтобы соответствовать действительности.

...