【VBA】重複データをバックグラウンドでPDF保存する方法
手作業での重複データの選別とPDF化は時間がかかります。この記事では、VBAを使用してそのプロセスを自動化し、効率的に業務を進めましょう。
サンプルコード
VBA
Option Explicit
Sub SaveDuplicateDataAsPDF()
' ワークシートオブジェクトの定義
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("データ")
' 最終行の取得
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' データ保存用配列
Dim data() As Variant
ReDim data(1 To lastRow - 1, 1 To 2)
' カウンタ変数
Dim i As Long
Dim j As Long
j = 0
Application.ScreenUpdating = False
For i = 2 To lastRow
If IsDuplicate(ws.Cells(i, 1).Value) Then
j = j + 1
data(j, 1) = ws.Cells(i, 1).Value
data(j, 2) = ws.Cells(i, 2).Value
End If
Next i
' データ範囲の定義とPDF保存
Dim rng As Range
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2))
With rng
.AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd
.SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets.Add.Name = "TempSheet"
Set rng = ThisWorkbook.Sheets("TempSheet")
rng.PasteSpecial xlPasteValues
With rng.Parent.PageSetup
.PrintArea = rng.Address
.FitToPagesWide = 1
.FitToPagesTall = False
End With
' PDF保存
Application.DisplayAlerts = False
rng.Parent.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Public\Documents\DuplicateData.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.DisplayAlerts = True
End With
' 一時シート削除
ThisWorkbook.Sheets("TempSheet").Delete
' スクリーン更新再開
Application.ScreenUpdating = True
End Sub
Function IsDuplicate(ByVal value As Variant) As Boolean
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("データ")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow - 1
If ws.Cells(i, 1).Value = value Then IsDuplicate = True: Exit Function
Next i
End Functionよくある質問
Q 元に戻せますか?
A.
VBAの実行結果は「元に戻す」が効きません。必ずバックアップを取ってから実行してください。
Q エラーが出たら?
A.
シート名や列番号が正しいか確認してください。