Номер каждой строки при печати VBA

Question

Я нахожу совпадения в двух столбцах (myrange1 и myrange2), заполняя их в третьем столбце («R») листа sheet2. У меня есть мой Диапазон от колонки «R», распечатанный до PDF, но я хочу, чтобы каждый из них был последовательно пронумерован в PDF, то есть 1,2,3,4 и т. Д. Помощь очень ценится. Довольно новичок в VBA.

Sub matchcopy()
    Dim myrange1 As Range, myrange2 As Range, cell As Range

    With Sheets("Sheet1")
        Set myrange1 = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With

    With Sheets("Sheet2")
        Set myrange2 = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With

    For Each cell In myrange1
        If Not IsError(Application.Match(cell.Value, myrange2, 0)) Then  
            'cell.Value, myrange2, 0
            cell.Copy
            Sheet2.Range("R5000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        Else
            'MsgBox "no match is found in range"
        End If
    Next cell

    Columns("R:R").EntireColumn.AutoFit
    Call Set_PrintRnag
End Sub


Sub Set_PrintRnag()
    Dim LstRw As Long
    Dim Rng As Range

    LstRw = Cells(Rows.Count, "R").End(xlUp).Row
    Set Rng = Range("R1:R" & LstRw)

    With ActiveSheet.PageSetup
        .LeftHeader = "&C &B &20 Cohort List Report : " & Format(Date, 
    "mm/dd/yyyy")
    End With

    Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & _
      "\CohortList " & " " & Format(Date, "mm-dd-yyyy") & ".pdf", _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Answer 1

Как можно ближе к вашему коду, хотя цикл по диапазону всегда занимает много времени, и вы бы быстрее работали с массивами сравниваемых столбцов:

Option Explicit

Sub matchcopy()
    Dim i&
    Dim myrange1 As Range, myrange2 As Range, cell As Range
  ' You can use the Codenames instead of Worksheet("Sheet1") etc.
    Set myrange1 = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
    Set myrange2 = Sheet2.Range("A1", Sheet2.Range("A" & Rows.Count).End(xlUp))
    Sheet2.Range("R:S") = ""                 ' <~~ clear result columns

    For Each cell In myrange1               ' presumably unique items
        If Not IsError(Application.Match(cell.Value, myrange2, 0)) Then
            cell.Copy
            With Sheet2.Range("R5000").End(xlUp)
                i = i + 1                   ' <~~ counter
                .Offset(1, 0) = i           ' counter i equals .Row - 1
                .Offset(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
            End With
        Else
            'MsgBox "no match is found in range"
        End If
    Next cell

    Sheet2.Columns("R:S").EntireColumn.AutoFit
    Call Set_PrintRnag                      ' called procedure see OP
End Sub

Sub Set_PrintRnag()
Dim LstRw As Long
Dim Rng As Range

LstRw = Sheet2.Cells(Rows.Count, "R").End(xlUp).Row
Set Rng = Sheet2.Range("R1:S" & LstRw)

With Sheet2.PageSetup
    .LeftHeader = "&C &B &20 Cohort List Report : " & Format(Date, "mm/dd/yyyy")
End With

Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & _
  "\CohortList " & " " & Format(Date, "mm-dd-yyyy") & ".pdf", _
  Quality:=xlQualityStandard, IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Дополнительная подсказка

Чтобы получить некоторые идеи о том, как использовать массив полей данных, см., Например, Ответ SO * Цикл с несколькими диапазонами

Answer 2

Вам нужен сценарий VBA для достижения желаемой цели? Если вы просто пытаетесь сравнить два значения и вывести результат в ваш столбец R, вы сможете сделать это с помощью функции IF: https://support.office.com/en-us/article/if-function-69aed7c9-4e8a-4755-a9bc-aa8bbff73be2

Если вы хотите использовать последовательную нумерацию для результатов, я бы посоветовал указать номер в соседнем столбце и изучить функцию COUNTA: https://support.office.com/en-us/article/counta-function-7dc98875-d5c1-46f1-9a82-53f3219e2509

И если вам требуется это в формате сценариев VBA, вы можете сделать это сначала с помощью функции Excel, а затем записать макрос. Делает создание фактического синтаксиса VBA немного проще! https://support.office.com/en-us/article/automate-tasks-with-the-macro-recorder-974ef220-f716-4e01-b015-3ea70e64937b