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

在打印VBA时为每行编号

2 个答案: