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

时间:2013-10-22 22:30:47

标签: excel vba formula vlookup filedialog

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

我必须在4个不同的工作表上执行此操作,并且我必须输入此公式的列具有“订单等级”标题。我用一个.Find来返回“订单等级”的位置。然后,我想在下面找到“订单等级”的Vlookup 1行。

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

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

VBA 中我想要构建的公式看起来像这样:

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

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

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

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$1:" & LastColumn & lastrow & ",2,False"
End Sub

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

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

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

1 个答案:

答案 0 :(得分:0)

未测试:

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