VBA中使用索引匹配的范围与范围单元格

时间:2017-03-21 20:47:44

标签: excel-vba vba excel

我很难在VBA中使用Range Cells方法和Index Match。使用标准范围工作正常,但我对Range Cells没有运气。我必须未能掌握关于指数匹配的基本信息。我已经注释掉了失败的代码行。我感谢社区提供的任何指示。

    Sub IndexMatchTroubleShooting()

'dim worksheets
Dim Source As Worksheet
Dim Target As Worksheet

'set worksheets
Set Source = ThisWorkbook.Sheets("Source")
Set Target = ThisWorkbook.Sheets("Target")

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

'using range <-this works
Set ValuesToPull = Source.Range("B1:B5682")
Set TargetIDs = Target.Range("A1:A21")
Set SourceIDs = Source.Range("A1:A5682")
Set MyRange = Target.Range("B1:B21")

'using range cells <-this produces this error: "Run-time Error 1004 Method 'Range' of object '_Worksheet' failed"
'Set ValuesToPull = Source.Range(Cells(1, 2), Cells(5682, 2))
'Set TargetIDs = Target.Range(Cells(1, 1), Cells(21, 1))
'Set SourceIDs = Source.Range(Cells(1, 1), Cells(5682, 1))
'Set MyRange = Target.Range(Cells(1, 2), Cells(21, 2))

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

End Sub

2 个答案:

答案 0 :(得分:3)

您需要使用工作表完全限定所有范围/单元格引用,因为如果运行宏时其他工作表处于活动状态,则会出错,例如

Set ValuesToPull = Source.Range(Source.Cells(1, 2), Source.Cells(5682, 2))

或保存一点打字

With Source
    Set ValuesToPull = .Range(.Cells(1, 2), .Cells(5682, 2))
    Set SourceIDs = .Range(.Cells(1, 1), .Cells(5682, 1))
End With
With Target
    Set TargetIDs = .Range(.Cells(1, 1), .Cells(21, 1))
    Set MyRange = .Range(.Cells(1, 2), .Cells(21, 2))
End With

(不确定你可以在匹配公式中使用多单元格范围 - 有人知道吗?)

答案 1 :(得分:0)

    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