尝试使用 VBA 索引匹配匹配并失败

Question

我正在尝试识别交集是我要检索的数据的行和列，就像 Excel 中的索引匹配匹配公式一样。我的方法是在列中查找数据，获取列字母，然后对行中的数据执行相同操作并检索行号。我遇到的问题是我必须在宏所在的单独工作簿中引用一个单元格，以打开另一个随月份更改的电子表格名称。我敢肯定这整件事的方法不是很好，不胜感激！

    Option Explicit

Sub RevenueTest()

'GVS1 Revenue Index Match Test

'DELETES & COPIES GVS1 revenue into P&R File

Dim GVS1 As String
GVS1 = ThisWorkbook.Sheets("Revenue").Range("v13")

Dim GVS1IS As String
GVS1IS = ThisWorkbook.Sheets("Revenue").Range("V7")

Dim GVS1Open As String
GVS1Open = Excel.Workbooks.Open(GVS1)

Dim Row As String
Row = Range("B5:B25").Find("Generation").Select.ActiveCell.Row

Dim Month As String
Month = ThisWorkbook.Sheets("Revenue").Range("V4")

Dim MonthActual As String
MonthActual = Month & " Actual"

Dim Column As String
Column = Range("A1:P15").Find(MonthActual).Select.ActiveCell.Column

Dim GVS1RowAndColumn As String
GVS1RowAndColumn = Column & Row

'OPENS / Indexes and Copies Revenue

    Excel.Workbooks.Open (GVS1)
    Columns("C:Q").EntireColumn.Delete
    Range(GVS1RowAndColumn).Copy
        
        
'PASTES GVS1 revenue into P&R File
Dim Revenue As Worksheet
Set Revenue = ThisWorkbook.Sheets("Revenue")
     
ThisWorkbook.Activate
 Revenue.Range("D3:D11").Find("Revenue").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Range("A1").PasteSpecial xlPasteValues
  

End Sub

Answer 1

为了理解您的代码，我重新排列了它。为了让您理解您的代码，我已对其进行了评论。要清楚：这是您的代码，未更改！我们只是学习。

Sub RevenueTest()
    'GVS1 Revenue Index Match Test
    'DELETES & COPIES GVS1 revenue into P&R File
    
    Dim Revenue             As Worksheet
    Dim GVS1                As String
    Dim GVS1IS              As String
    Dim GVS1Open            As String
    Dim Row                 As String               ' "Row" is an Excel object
    Dim Month               As String
    Dim MonthActual         As String
    Dim Column              As String               ' "Column" is an Excel object
    Dim GVS1RowAndColumn    As String
    
    GVS1 = ThisWorkbook.Sheets("Revenue").Range("V13")
    GVS1IS = ThisWorkbook.Sheets("Revenue").Range("V7")
    GVS1Open = Excel.Workbooks.Open(GVS1)           ' the workbook is an object: can't assign to String
    
    ' "ActiveCell.Row" is a number: why assign to a string variable?
    ' "Row" is an object: can't be the name of a variable
    ' don't select anything: create a range object instead
    ' "Find" returns a range object if successful
    '   if unsuccessful attempting to access that range must fail
    ' since you don't specify any sheet, 'Range("B5:B25")' is presumed
    '   to be on the ActiveSheet
    Row = Range("B5:B25").Find("Generation").Select.ActiveCell.Row
    
    Month = ThisWorkbook.Sheets("Revenue").Range("V4")
    MonthActual = Month & " Actual"
    Column = Range("A1:P15").Find(MonthActual).Select.ActiveCell.Column
    GVS1RowAndColumn = Column & Row
    
    'OPENS / Indexes and Copies Revenue
    Excel.Workbooks.Open GVS1                       ' don't enclose arguments in parentheses
    Columns("C:Q").EntireColumn.Delete              ' columns are in the ActiveSheet
    Range(GVS1RowAndColumn).Copy                    ' Range is on the ActiveSheet
            
    'PASTES GVS1 revenue into P&R File
    Set Revenue = ThisWorkbook.Sheets("Revenue")
         
    ThisWorkbook.Activate                           ' no need to activate anything
    Revenue.Range("D3:D11").Find("Revenue").Select  ' no need to select anything
    Selection.End(xlToRight).Select                 '
    ActiveCell.Offset(0, 1).Range("A1").PasteSpecial xlPasteValues
End Sub

然后我尝试重新编写您的代码，以便它可以工作。你可以看到我走了多远。查找搜索范围的规范。他们在ActiveSheet。 ActiveSheet 是哪个？我们毫无头绪。但代码向您展示了如何处理该主题。

Sub RevenueTest_2()

    Dim GVS1Book            As Workbook
    Dim Revenue             As Worksheet
    Dim Fnd                 As Range                ' result of 'Find'
    Dim R                   As Long                 ' a row number
    Dim C                   As Long                 ' a column number
    Dim GVS1                As String
    Dim GVS1IS              As String
    Dim Month               As String

    Set Revenue = ThisWorkbook.Sheets("Revenue")    ' use "Set" to assign an object to a variable
    With Revenue
        GVS1 = .Range("V13").Value                  ' { always specify the property you want
        GVS1IS = .Range("V7").Value                 ' { here it's the Value
        Month = .Range("V4").Value                  ' "Month" is a string (like "April", not 4)
    End With
    
    Set Fnd = ActiveSheet.Range("B5:B25").Find("Generation")
    If Fnd Is Nothing Then
        MsgBox """Generation"" not found."
        Exit Sub
    Else
        R = Fnd.Row
    End If
    
    Set Fnd = ActiveSheet.Range("A1:P15").Find(Month & " Actual")
    If Fnd Is Nothing Then
        MsgBox """" & Month & " Actual"" not found."
        Exit Sub
    Else
        C = Fnd.Column
    End If
    
    Set GVS1Book = Workbooks.Open(GVS1)            ' GVS1 must be a path & name
End Sub

当打开另一个工作簿时，我放弃了。那时，Excel 将使该工作簿成为 ActiveWorkbook，而在保存该工作簿时处于活动状态的工作表将成为 ActiveSheet。您的代码立即开始删除该未知工作表上的列。我无法让自己这样做。

当您完成我开始编写的代码时，请记住您不需要激活其他工作簿。 Excel 已经为您完成了这项工作，并且当您关闭该书时，它会返回您原来的视图。考虑使用Application.ScreenUpdating = False 不显示活动工作表。您无需选择要删除列的任何工作表。但是您确实需要指定您采取行动的工作表。我非常怀疑我的代码是否会在正确的工作表上查找两个搜索条件。我指定了ActiveSheet，因为这就是您的代码所暗示的。所以我们可能都错了:-)

Answer 2

我不确定我是否正确理解了这一行

我的方法是在列中查找数据，获取列字母，对行中的数据做同样的操作，检索行号。

但我的股票中确实有类似的指数匹配功能，请查看并根据您的需要进行修改。

Option Explicit

Sub Return_value()

Dim Rmrks As Range, Itm_Rng As Range
Dim ItmLstPR As Range, ItmLstCode As Range

On Error Resume Next

With Application
    .EnableEvents = False
    .ScreenUpdating = False

'they are table range btw like, "tabe_name[column_name]"
'in this range the return value will be pasted
Set Rmrks = .Range("Pip_Line[Remarks]")
'this range has the key word that needs to be matched
Set Itm_Rng = .Range("Pip_Line[Item_Code]")


' from "DMY_Pip_Line[Remarks]" range matched value will be returned
Set ItmLstPR = .Range("DMY_Pip_Line[Remarks]")

'we use "DMY_Pip_Line[Item_Code]" to match our keyword from "Pip_Line[Item_Code]" range
Set ItmLstCode = .Range("DMY_Pip_Line[Item_Code]")

        'Return Remarks
    Call Match_Value(ItmLstPR, Itm_Rng, ItmLstCode, Rmrks)
    
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

您可以在工作表或模块中插入上述代码。

将以下代码粘贴到模块中以获得最终结果。

Option Explicit

Public Sub Match_Value(ByVal ReturnVal As Range, ByVal LookupVal As Range, ByVal LookupRng As Range, ByVal PasteRng As Range)

Dim rng As Range, ResultRow As Long, foundcell As Range, ColmnDist As Long, FoundVal As String

'find column offset
ColmnDist = ReturnVal.Column - LookupRng.Column
ResultRow = PasteRng.Column - LookupVal.Column

On Error Resume Next
For Each rng In LookupVal
'return due placing location row
    Set foundcell = LookupRng.Find(rng.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
    
    'return value
    FoundVal = foundcell.Offset(0, ColmnDist).Value
    
    If Not foundcell Is Nothing And FoundVal <> vbNullString Then

       rng.Offset(0, ResultRow).Value = FoundVal

    End If
   
Next

End Sub