使用“索引匹配”可以提取多列数据

时间:2017-03-22 18:18:37

标签: excel-vba vba excel

以下脚本允许用户通过一系列输入框执行索引匹配功能。此版本仅允许用户在每次使用时提取一列数据。我想知道是否可以更改此代码以允许用户提取多列数据。我感谢社区提供的任何反馈。

Sub MatchMaster()

'this script helps simplify the use of Excel's Index Match function
'place this script in your personal macro workbook and assign it to a button
'use it to pull data between two worksheets that share unique identifiers

'dim ranges
Dim ValuesToPull As Range
Dim TargetIDs As Range
Dim SourceIDs As Range
Dim MyRange As Range

'dim worksheets
Dim Source1 As Worksheet
Dim Target1 As Worksheet
Dim Source2 As Worksheet
Dim Target2 As Worksheet

'input box dims
Dim Prompt1 As String
Dim Prompt2 As String
Dim Prompt3 As String
Dim Prompt4 As String
Dim Title1 As String
Dim Title2 As String
Dim Title3 As String
Dim Title4 As String

'set prompts
Prompt1 = "Select values to pull (1 column only)"
Prompt2 = "Select unique IDs on target sheet (1 column only)"
Prompt3 = "Select unique IDs on source sheet (1 column only)"
Prompt4 = "Where should we put these values? (1 column only)"

'set titles
Title1 = "Source Sheet"
Title2 = "Target Sheet"
Title3 = "Source Sheet"
Title4 = "Target Sheet"

'error handling
On Error GoTo OuttaHere

'input boxes
Set SourceIDs = Application.InputBox(Prompt3, Title3, Type:=8)
Set Source1 = SourceIDs.Worksheet
SourceIDcolumn = SourceIDs.Column
LastSourceID = Source1.Cells(Rows.Count, SourceIDcolumn).End(xlUp).Row
Source1.Activate

Set ValuesToPull = Application.InputBox(Prompt1, Title1, Type:=8)
Set Source2 = ValuesToPull.Worksheet
ValuesColumn = ValuesToPull.Column
LastValue = Source2.Cells(Rows.Count, ValuesColumn).End(xlUp).Row
Source2.Activate

Set TargetIDs = Application.InputBox(Prompt2, Title2, Type:=8)
Set Target1 = TargetIDs.Worksheet
TargetIDcolumn = TargetIDs.Column
LastTargetID = Target1.Cells(Rows.Count, TargetIDcolumn).End(xlUp).Row '<~~ also use this for MyRange
Target1.Activate

Set MyRange = Application.InputBox(Prompt4, Title4, Type:=8)
Set Target2 = MyRange.Worksheet
MyColumn = MyRange.Column
Target2.Activate

'convert input to Range Cells format
With Source1
    Set SourceIDs = .Range(.Cells(1, SourceIDcolumn), .Cells(LastSourceID, SourceIDcolumn))
End With

With Source2
    Set ValuesToPull = .Range(.Cells(1, ValuesColumn), .Cells(LastValue, ValuesColumn))
End With

With Target1
     Set TargetIDs = .Range(.Cells(1, TargetIDcolumn), .Cells(LastTargetID, TargetIDcolumn))
End With

With Target2
     Set MyRange = .Range(.Cells(1, MyColumn), .Cells(LastTargetID, MyColumn))
End With

'apply formula
MyRange = Application.Index(ValuesToPull, Application.Match(TargetIDs, SourceIDs, 0))

OuttaHere:
ActiveWorkbook.ActiveSheet.Columns.AutoFit

End Sub

0 个答案:

没有答案