Несколько функций If

Question

Мне нужна помощь для моего кода. Я хочу скопировать имя клиента в столбце C на основе этих 2 условий, если:

1. Значение поиска макроса = "выполняется" в столбце G
2. Значение макроса найти = "Istry" в столбце D

Другими словами, если макрос обнаружит «текущий» и «истри» в одной строке, он автоматически скопирует имя клиента, связанное с этими двумя значениями, заданными на другом листе.

Я написал код, но когда я попытался запустить его, я не получил никакого результата на своем листе.

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

Вы можете использовать фильтр.

Обязательно установите соответствующие ссылки на листе.

Как написано, код копирует всю строку, но вы можете легко изменить ее, если хотите скопировать только несколько полей.

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

Answer 2

Здесь можно сделать некоторые предположения о вашем намерении использовать этот код:

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