我在两列(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
最佳答案
尽可能接近您的代码,尽管循环遍历一个范围总是很耗时,并且您可以更快地处理要比较的列的数组:
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
关于excel - 打印 VBA 时为每一行编号,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53162276/