excel - 多个 If 函数

Question

我的代码需要一些帮助。如果出现以下情况，我想根据这两个条件在 C 列上复制客户的姓名：

1. 宏查找值 = G 列上的“正在进行”
2. 宏查找值 = D 列上的“Istry”

换句话说，如果宏在同一行找到“ongoing”和“istry”，它将自动复制与在另一张纸上询问的这两个值相关联的客户名称。

我写了一个代码，但是当我尝试运行它时，我的工作表上没有任何结果。

Sub Ss()

Dim finalrow As Long, i As Long, rowpt As Long, colpt As Long

    finalrow = ShSReturn.Range("D" & "G" & Rows.Count).End(xlUp).Row
    rowpt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colpt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row


    Call Entry_Point

    For i = 7 To finalrow
        If ShSReturn.Cells(i, 4).Value = "Istry" & ShSReturn.Cells(i, 7).Value = "Ongoing" Then
            ShSReturn.Cells(i, 3).Copy
            ShPPT.Cells(rowpt + 6, 12).PasteSpecial xlPasteValues

            rowpt = rowpt + 1
            colpt = colpt + 1

        End If

    Next i

End Sub

Answer 1

在这里对您对这段代码的意图进行一些假设是一个快速的重写：

Sub Ss()

    Dim finalrow As Long, i As Long, rowpt As Long, colpt As Long

    'Determine how many rows we need to loop:
    finalDRow = ShSReturn.Range("D" & Rows.Count).End(xlUp).Row
    finalGRow = ShSReturn.RAnge("G" & Rows.Count).End(xlUp).Row

    'Loop only through rows were both G and D have records
    If finalDRow < finalGRow Then finalrow = finalDRow Else finalRow = finalGRow


    'I don't know what these two are doing, but they will return the same exact number (the last row populated in column A of whatever worksheet object is in ShPPT
    rowpt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colpt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row


    Call Entry_Point

    'Loop through rows 7 to whatever finalRow shakes out to be above
    For i = 7 To finalrow
        'If column D is "Istry" AND column G is "Ongoing" Then execute this code.
        If ShSReturn.Cells(i, 4).Value = "Istry" AND ShSReturn.Cells(i, 7).Value = "Ongoing" Then
            ShSReturn.Cells(i, 3).Copy
            ShPPT.Cells(rowpt + 6, 12).PasteSpecial xlPasteValues

            rowpt = rowpt + 1
            colpt = colpt + 1

        End If  

    Next i

End Sub

Answer 2

您可以使用过滤器。

请务必设置适当的工作表引用。

如所写，代码复制了整行，但如果您只想复制几个字段，则可以轻松修改它。

Option Explicit
Option Compare Text
Sub filterName()
    Const strG = "ongoing"
    Const strD = "lstry"
    Dim rCopyTo As Range
    Dim rData As Range
    Dim lastRow As Long, LastCol As Long

With Worksheets("Sheet6")
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rData = .Range(.Cells(1, 1), .Cells(lastRow, LastCol))
End With

Set rCopyTo = Worksheets("sheet7").Cells(1, 1)

Application.ScreenUpdating = False
rData.AutoFilter field:=4, Criteria1:=strD, visibledropdown:=False
rData.AutoFilter field:=7, Criteria1:=strG, visibledropdown:=False

rCopyTo.Cells.Clear
rData.SpecialCells(xlCellTypeVisible).Copy rCopyTo
rData.Worksheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub