使用 VBA 使用用户选择的文件在单元格中输入 vlookup 函数

Using VBA to enter a vlookup function in a cell using user chosen file

提问by John Young

I am trying to build a sub that will enter a formula into a cell, filldown the vlookupformula to lastrow, then copy the formula and pastespecial->valuesfor the entire range. The table I use in vLookupis located in a separate file that is not always stored in the same location. The Table is always formatted the same, but the table size is not always the same.

我正在尝试构建一个将公式输入单元格的子程序，将公式填充vlookup到最后一行，然后复制公式和pastespecial->values整个范围。我使用的表vLookup位于一个单独的文件中，该文件并不总是存储在同一位置。表的格式总是相同的，但表的大小并不总是相同的。

I have to do this on 4 different worksheets and the column that I have to enter this formula in has a heading of "Order Grade". I use a .Find to return the location of "Order Grade". I then want to enter my Vlookup 1 row below where "Order Grade" is found.

我必须在 4 个不同的工作表上执行此操作，并且必须在其中输入此公式的列的标题为“订单等级”。我使用 .Find 来返回“Order Grade”的位置。然后，我想在找到“订单等级”的下方输入我的 Vlookup 1 行。

if I enter the formula manuallyon the worksheet it looks like this:

如果我在工作表上手动输入公式，它看起来像这样：

=VLOOKUP(C2,[newpipe.xlsx]Sheet1!$A:$B6,2,FALSE)    

in VBAthe formula I want to construct would look something like this:

在VBA 中，我想要构建的公式如下所示：

=vlookup(RC[-1],stringFileName\[newpipe.xlsx]Sheet1!$A:LastColumn & LastRow,2,False

With the user choosing the stringFileName using an open file dialog box. LastColumn and LastRow on the chosen sheet should be calculated by the macro.

用户使用打开的文件对话框选择 stringFileName。所选工作表上的 LastColumn 和 LastRow 应由宏计算。

Here is what I have so far.

这是我到目前为止所拥有的。

Private Function UseFileDialogOpen()
Dim myString As String
' Open the file dialog
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 1 Then
        myString = .SelectedItems(1)
        'MsgBox myString
        UseFileDialogOpen = myString
    Else
        MsgBox ("Failed to properly open file")
        myString = "fail"
        UseFileDialogOpen = myString
    End If
End With
End Function

Sub formatOrderColumn()
Dim strSearch
Dim foundColumn
Dim foundRow
Dim RowBelowSpotFound
Dim fileLocation

strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

If Not aCell Is Nothing Then
    foundColumn = aCell.Column
    foundRow = aCell.Row
    spotFound = ColumnLetter(foundColumn) & foundRow + 1
'    MsgBox "Value Found in Row " & foundRow & _
    " and the Column Number is " & foundColumn
Else
    Exit Sub
End If

fileLocation = UseFileDialogOpen()
LastColumn = FindLastColumn(UserSelectedSheet)
LastRow = FindLastRow(UserSelectedSheet)
Range(RowBelowSpotFound).Formula = _
    "=vlookup(RC[-1], [" & fileLocation & "]Sheet1!$A:" & LastColumn & lastrow & ",2,False"
End Sub

I do not know how to get the lastrow and lastColumn from the user chosen file. I have functions that do that for any Worksheet that is passed to them. I realize I did a pretty poor job explaining my situation and am not at all sure I am going about this the best way. If you have any questions let me know and I'll do my best to clarify. I'll be leaving the office soon so may not be able to reply until the morning.

我不知道如何从用户选择的文件中获取 lastrow 和 lastColumn。我有为传递给它们的任何工作表执行此操作的函数。我意识到我在解释我的情况时做得很差，我完全不确定我是否会以最好的方式解决这个问题。如果您有任何问题，请告诉我，我会尽力澄清。我很快就要离开办公室，所以可能要到早上才能回复。

Here is new formula. I get error on last line when I try to set the offset cell formula to the string value. The string value is correct. I get the same error if I try to set the cell value directly without using the mystring holder to first build the string. "application or object defined error"

这是新公式。当我尝试将偏移单元格公式设置为字符串值时，在最后一行出现错误。字符串值是正确的。如果我尝试直接设置单元格值而不使用 mystring 持有者首先构建字符串，则会出现相同的错误。“应用程序或对象定义错误”

Sub vlookupOrderGrade()

Dim strSearch
Dim fileLocation
Dim aCell As Range
Dim aCellString
Dim myString As String
strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
                                 Lookat:=xlWhole, MatchCase:=True)
If Not aCell Is Nothing Then
    fileLocation = UseFileDialogOpen()
    If fileLocation <> "fail" Then
        'replace last "\" with a "["
        fileLocation = StrReverse(fileLocation)
        fileLocation = Replace(fileLocation, "\", "[", 1, 1)
        fileLocation = StrReverse(fileLocation)
        'build string
        myString = "=vlookup(" & _
                     ColumnLetter(aCell.Column - 1) & aCell.Row + 1 & _
                     ", '" & fileLocation & "]Sheet1'!$A:$B,2,False"
        MsgBox (myString)
        'set cell to string
        aCell.Offset(1, 0).Formula = myString
    End If
Else
    Exit Sub
End If
End Sub

采纳答案by Tim Williams

Untested:

未经测试：

Sub formatOrderColumn()

Dim strSearch
Dim fileLocation

strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
                                     Lookat:=xlWhole, MatchCase:=True)

    If Not aCell Is Nothing Then

        fileLocation = UseFileDialogOpen()
        If fileLocation <> "fail" Then

            aCell.Offset(1, 0).Formula = "=vlookup(" & _
                         aCell.Offset(1, -1).Address(False, False) & _
                         ", '[" & fileLocation & "]Sheet1'!$A:$B,2,False"
        End If
    Else
        Exit Sub
    End If

End Sub