Question

我有一个宏来检查sheet2中A列和第2行的匹配值。基于B3到C6范围内的每个值（动态字段可能会在sheet1中更改（最多7个位置，低于5个角色，可能会出现在这里）。

我的代码问题是我的循环＆＃34; j＆＃34; 没有按预期工作...这将导致在每个下面的场景中执行代码8到16次（我希望它只运行4次）

Sub GetRowNum()

Dim rLoc 
Dim rRol 
Dim LocSrch1 
Dim RolSrch1 
Dim disRangeLoc As Range 
Dim disRangeRol As Range 
Dim i 
Dim j 
Dim shtA As Worksheet

Dim lRow As Long 
Dim lCol As Long 
Dim lInter As Variant 
Dim Table As Range

Set shtA = Sheets ("Sheet1") 'storing the sheets... 
Set shtB = Sheets ("Sheet2")

shtA.Activate 

rLoc = shtA.Range("B2").End(xlDown).Row 
rRol = shtA.Range("C2").End(xlDown).Row 'the last row of the list 


LocSrch1 = 2 'column A... changed if you need 
Set disRangeLoc = Range(Cells(3, LocSrch1), Cells(rLoc, LocSrch1)) 'here need to change the 2 for 
'1 if you do not want headers

RolSrch1 = 3 'column A... changed if you need 
Set disRangeRol = Range(Cells(3, RolSrch1), Cells(rRol, RolSrch1))


For Each i In disRangeLoc 'for each item inside the list of prod going to discount 
For Each j In disRangeRol 
MsgBox i 
MsgBox j 
shtB.Activate

Set Table = shtB.Range("A1:H7")

On Error Resume Next 
lRow = shtB.Application.WorksheetFunction.Match(j, Range("A:A"), 0) 
On Error GoTo 0

If lRow > 0 Then 
End If

On Error Resume Next 
lCol = shtB.Application.WorksheetFunction.Match(i, Range("2:2"), 0) 
On Error GoTo 0

If lRow > 0 Then 
End If

On Error Resume Next 
lInter = Application.WorksheetFunction(lCol, lRow).Value 
On Error GoTo 0

If lRow > 0 Then

MsgBox Table.Cells(lRow, lCol).Value

End If

On Error GoTo 0 
Next j 
Next i


End Sub

我的最终目标是找到D7下的收入，如图1（表1）所示，此代码是朝向它的第一步...如果有人有更好的建议以这么简单的方式计算，请指导我。< / p>

有人，请帮我纠正我的代码......我希望你理解我的要求......请问，我会尽力解释

提前致谢

Answer 1

如果设置For Each j In disRangeRol，那么它将采用您已定义范围内的每个值。如果您保留Set J = I.Offset(0, 1)，那么它会考虑并检查＆＃39; i＆＃39; 中的值，如果为true，它将采用恰到好处的值，并且不会去对于disRangeRol中的每个值，请尝试以下代码

Sub GetRowNum() 'find the value from Sheet2 if Location and Role matches

    Dim rLoc
    Dim rRol
    Dim LocSrch1
    Dim RolSrch1
    Dim disRangeLoc As Range
    Dim disRangeRol As Range
    Dim I
    Dim J
    Dim shtA As Worksheet
    Dim shtB As Worksheet

Dim lRow As Long
Dim lCol As Long
Dim lInter As Variant
Dim Table As Range

    Set shtA = Sheets("Sheet1")
    Set shtB = Sheets("Sheet2")

    shtA.Activate

    rLoc = shtA.Range("B2").End(xlDown).row
    rRol = shtA.Range("C2").End(xlDown).row 'the last row of the list
                                    'with the discounted prods
                                    'If you do not want headers,
                                    'use A1 here


    LocSrch1 = 2 'column B... changed if you need
    Set disRangeLoc = Range(Cells(3, LocSrch1), Cells(rLoc, LocSrch1))  'here need to change the 2 for
                                                   '1 if you do not want headers

    RolSrch1 = 3 'column A... changed if you need
    Set disRangeRol = Range(Cells(3, RolSrch1), Cells(rRol, RolSrch1))


    For Each I In disRangeLoc 'for each item inside the list of prod going to discount
  Set J = I.Offset(0, 1) 'it will check the value in i if yes it will take the value just right to it

  shtB.Activate

Set Table = shtB.Range("A1:H7")

On Error Resume Next
    lRow = shtB.Application.WorksheetFunction.Match(J, Range("A:A"), 0)
    On Error GoTo 0

    If lRow > 0 Then
    End If

On Error Resume Next
    lCol = shtB.Application.WorksheetFunction.Match(I, Range("2:2"), 0)
    On Error GoTo 0

    If lRow > 0 Then
    End If

On Error Resume Next
    lInter = Application.WorksheetFunction(lCol, lRow).Value
    On Error GoTo 0

    If lRow > 0 Then

'MsgBox I
'MsgBox J
MsgBox Table.Cells(lRow, lCol).Value
RevValue = Table.Cells(lRow, lCol).Value 'it will set the values each time the loop run
    End If

        On Error GoTo 0

shtA.Activate ' help to make sure you feed the date in right sheet, else data will get feed to Sheet2

   ActiveCell.Value = RevValue & "," & ActiveCell.Value 'this will feed the date into the field using a comma separation 

    Next I

    shtA.Activate

End Sub

更新了将数据提供给特定列的代码

VBA：我怎样才能限制每个＆＃39; For Each＆＃39;功能

1 个答案: