允许用户在另一个工作簿中搜索列表并返回单元格值

时间:2016-03-08 01:44:01

标签: excel vba excel-vba

信息

工作簿A:有一个包含项目列表的主工作表,但这些值按月列排列

练习册B:我有两张不同的项目列表,我想用它来搜索工作簿A并返回我需要的当前或特定月份。

注意:工作簿B列是偏移的,因此我们可能需要对此进行说明。

到目前为止我的代码:

Sub Button()

Dim OpenFileName As String
Dim MyWB As Workbook, wb As Workbook
Dim aRange As Range

'Excel titled, "MODs", contains this module
Set MyWB = ThisWorkbook

'Ignore possible messages on a excel that has links

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

'Select and Open workbook
OpenFileName = Application.GetOpenFilename '("clients saved spreadsheet,*.xlsb")
If OpenFileName = "False" Then Exit Sub

Set wb = Workbooks.Open(OpenFileName)
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True


If MsgBox("Please select list range to search.", vbExclamation, "Search List") = vbOK Then

On Error Resume Next
Set aRange = Application.InputBox(prompt:="Enter range", Type:=8)
If aRange Is Nothing Then
  MsgBox "Operation Cancelled"
Else
  aRange.Select
End If

End If

End Sub

我可能会比现在更努力,所以我愿意接受建议。我似乎无法找到正确的查找功能来使用我选择的范围列表,并使用特定的主工作表(类似于vlookup)将新打开的工作簿作为目标。

版本2:设定范围,但我仍然没有获得价值回报

Sub Button()
Dim OpenFileName As String
Dim MyWB As Workbook, wb As Workbook
Dim MyWs As Worksheet, ws As Worksheet
Dim aRange As Range


'This line of code turns off the screen updates which make the macro run much faster.
'Application.ScreenUpdating = False

'Excel titled, "MODs", contains this module
Set MyWB = ThisWorkbook
Set MyWs = MyWB.Sheets("Sheet")

'Ignore possible messages on a excel that has links
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

'Select and Open workbook
OpenFileName = Application.GetOpenFilename '("clients saved spreadsheet,*.xlsb")
If OpenFileName = "False" Then Exit Sub

Set wb = Workbooks.Open(OpenFileName)

On Error Resume Next
Set ws = Application.InputBox("Select a cell on the key sheet.", Type:=8).Parent
On Error GoTo 0

If ws Is Nothing Then
    MsgBox "cancelled"
Else
    MsgBox "You selected sheet " & ws.Name
End If

Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

With MyWs
    For Each aCell In .Range("A1:A10" & LastRow)
        If Len(Trim(.Range("A19" & aCell.Row).Value)) <> 0 Then
            .Cells(aCell.Row, 15) = Application.WorksheetFunction.VLookup( _
                                    aCell.Value, ws.Range("A1:C18"), 2, 0)
        End If
    Next aCell
End With

'wb.Close (False)

'If MsgBox("Please select list range to search.", vbExclamation, "Search List") = vbOK Then
    'On Error Resume Next
    'Set aRange = Application.InputBox(prompt:="Enter range", Type:=8)
    'If aRange Is Nothing Then
      'MsgBox "Operation Cancelled"
    'Else
      'aRange.Select
    'End If
'End If

'Return to default setting of screen updating.
'Application.ScreenUpdating = True
End Sub

我认为我遇到的问题是这段代码:

With MyWs
    For Each aCell In .Range("A1:A10" & LastRow)
        If Len(Trim(.Range("A19" & aCell.Row).Value)) <> 0 Then
            .Cells(aCell.Row, 15) = Application.WorksheetFunction.VLookup( _
                                    aCell.Value, ws.Range("A1:C18"), 2, 0)

1 个答案:

答案 0 :(得分:0)

开始声明aCell as RangelastRow as long

您似乎错过了lastRow的定义,可能类似于

lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

然后仔细查看.Range("A1:A10" & LastRow)。假设lastRow为100,那么这将设置从A1到A10100的范围:这是你想要的吗?或者可能是你使用

.Range("A1:A" & lastRow)

再次.Range("A19" & aCell.Row)将导致单个单元格地址,例如“A1989”(aCell.Row = 89):这就是你想要的吗?

除了上面的内容,我无法掌握你在哪里搜索的实际场景。您可能想要提供有关该

的更多信息