打印 VBA 时为每一行编号

Question

我在两列（myrange1 和 myrange2）中找到匹配项，并将它们填充到 sheet2 的第三列（“R”）中。我的范围从“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

附加提示

要了解如何使用数据字段数组，请参阅例如所以回复Loop with multiple ranges

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