Question

有一点背景，我的工作表“数据”由一个表组成，我的宏应该填充这个表。该表的日期在第一列（列P）下运行，一些名称作为标题。我当前的宏，如下所示，循环遍历我的所有工作表，除了指定不循环的工作表，然后在每个工作表中它循环遍历W7：W200范围内的每个单元格。然后，它会查找单元格中正确的10个值与工作表“数据”中P列中的日期匹配（并将该行设置为HdrRow）。同时，它在A9中查找它循环的任何工作表中的值，以便将该值与工作表“Data”中的列标题相匹配（并将该列设置为HdrCol）。找到行和列（相交的单元格）后，宏会将正在循环的单元格的值粘贴到相交的单元格中。

我在下一部分遇到问题，我希望添加另一个标准来查找行。我希望宏不仅可以在P列中找到匹配的日期，而且还可以在Q列中找到一个值，该值与A1循环播放的表中的值相匹配;然后将该行设置为HdrRow。如果可能的话，id就像不使用循环一样。

Sub Values()
    Dim HdrCol As Range
    Dim Site As String
    Dim SearchRange As Range
    Dim HdrRow As Range
    Dim FinDate As Date
    Dim ws As Worksheet
    Dim rng As Range




    ' Fill in Actual Value
    Sheets("Data").Range("W2:W100000").ClearContents

    For Each ws In ActiveWorkbook.Worksheets
        'Dont Copy Data from these worksheets
        If ws.Name <> "Portfolio" And ws.Name <> "Master" And ws.Name <> "Template" _
            And ws.Name <> "Coal" And ws.Name <> "E&P" And ws.Name <> "Gen" _
            And ws.Name <> "Hydro" And ws.Name <> "LNG" And ws.Name <> "Midstream" _
            And ws.Name <> "Solar" And ws.Name <> "Transmission" _
            And ws.Name <> "Wind" And ws.Name <> "Data" Then

            For Each cell In ws.Range("W7:W200")

                If cell <> "          " Then

                    Site = ws.Range("A9").Value
                    FinDate = Right(cell, 10)

                    'Find column ref
                    Set HdrCol = Sheets("Data").Range("P1:W1").find(Site, lookat:=xlPart)
                    If Not HdrCol Is Nothing Then
                    End If

                    'Find row ref
                    Set SearchRange = Sheets("Data").Range("P1", Range("P100000").End(xlUp))
                    Set HdrRow = SearchRange.find(FinDate, LookIn:=xlValues, lookat:=xlWhole)


                    Application.Goto Reference:=Cells(HdrRow.Row, HdrCol.Column)

                    If IsEmpty(Sheets("Data").Cells(HdrRow.Row, HdrCol.Column)) Then
                        cell.Copy Sheets("Data").Cells(HdrRow.Row, HdrCol.Column)
                    Else
                        cell.Copy Sheets("Data").Cells(HdrRow.Row, HdrCol.Column).End(xlDown).Offset(1, 0)
                    End If
                End If
            Next
        End If
    Next
End Sub

Answer 1

我首先想到的非循环版本（循环更简单），将使用match（），但如果你有多个值，其中A = Q或使用相同的日期，你可能会运行成为一个问题。

Dim i,j as Integer

i=Application.Match(RefCell1,LookUp1,0).Row
j=Application.Match(RefCell2,LookUp2,0).Row

If i=j Then
    HdrRow=i
    Else
End If

我特别没有将该匹配场景设为If语句条件，因此更容易阅读和编辑。

使用这种方法会遇到多个相同值的问题。

另一种方法是使用嵌套的if语句：

Dim i as integer

i=Application.Match(RefCell1,LookUp1,0).Row

If Application.IfError(i,0)>0 Then
    If Cells(i,"Q").Value=Cells(RefCell1Row,"A").Value
        HdrRow=i
        Else
    End If
    Else
End If

最后，我仍然会推荐一个循环，这样你就可以评估每行的行数，这将建立在第二种方法的基础上。

编辑：每个请求，包含一个循环。

Dim i, j as Integer 

For i = 7 to 200 'Used the range you mentioned in your post, which I think is wrong for this example... these are row numbers for Data sheet
    For j = 7 to 200 'Row numbers for reference sheets
        If Sheet(ARRAY).Cells(j,"Q").Value=Sheets("Data").Cells(i,"A").Value Then
            If Cells(j,"P").Value=Cells(i,"B").Value 'Not sure what column the date is in Data sheet
                HdrRow=j
                Else
            End If
            Else
        End If
   Next j
Next i

结束两个循环，以考虑数据表中的单元格以及您在阵列中引用的每个工作表。确保关闭屏幕更新，因为癫痫是真的！

Excel VBA根据两列中的条件查找行号，无循环

1 个答案: