[[20250818150323]]　『VBAでオートフィルタで絞り込んでPDF化』（社会人）　ページの最後に飛ぶ

『VBAでオートフィルタで絞り込んでPDF化』（社会人）

はじめまして。会社で上司から下記を自動化できるよう指示されているエクセル初心者です。
VBAでオートフィルタで絞り込んでPDF化したいです。
　　A　　　B　　C　　・・・・Z
1　8/4　S1　60
2　8/1　S3　800
3　7/9　S7　500　
4　5/3　S9　60
・
・
・

こういう表があった時に、

"S1"で絞り込み
PDF化、ファイル名S1
"S3"で絞り込み
PDF化ファイル名S3
"S7"で絞り込み
PDF化ファイル名S7
"S9"で絞り込み
PDF化ファイル名S9

ということをしたいです。

https://kouten0430.hatenablog.com/entry/2019/08/30/172725
このサイトをもとにやってみたのですがなにかが違うのかこのサイトの印刷まですらいけません。
正直まったくの初心者でどこが間違っているのかなにもかも分からないです……。
どのようなVBAをつくればいいのでしょうか？
よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 貴方の質問文をそのままCopilotに投げると、
 それらしいコードを生成してくれます。
 上司から指示された業務であれば、可能な限り、
 自身の力で生み出してみては。

 上司に「掲示板で作ってもらいました！」とは
 言えないでしょうから。
（tkit） 2025/08/18(月) 16:52:54

やることが手作業でできるのであれば、マクロの記録で作って手を加える、直してみたらどうでしょうか？
（ゆたか） 2025/08/18(月) 17:01:02

 現在のコードを示してもらわないと何が悪いのかわかりませんよ
 ちなみに、参照先のコードの使い方は理解されてますか？

    Sub sample()
       Const keyColumn As Long = 2         ' 2列目でフィルタ
       Dim key As Variant
       Dim PDFSavePath As String
       PDFSavePath = ActiveWorkbook.Path   ' PDF保存先
       With ActiveSheet
          .AutoFilterMode = False
          .Range("A1").CurrentRegion.AutoFilter  ' A1を含むセル範囲でオートフィルタ
          For Each key In Rng2UniqSortAry(Intersect(.AutoFilter.Range, .AutoFilter.Range.Offset(1)).Columns(keyColumn))
             .AutoFilter.Range.AutoFilter Field:=keyColumn, Criteria1:=key
             .PrintPreview                                                      ' プレビュー
             '.ExportAsFixedFormat xlTypePDF, PDFSavePath & "\" & key & ".pdf"  ' PDFエクスポート
          Next
       End With
    End Sub

    Function Rng2UniqSortAry(Rng As Range) As Variant() ' セル範囲からユニークでソート済みの配列を作成 (UNIQUE関数・SORT関数の代替)
       Dim aCell As Range, Dic As Object, buf() As Variant
       Dim i As Long, j As Long, swp As Variant
       Set Dic = CreateObject("Scripting.Dictionary")
       ' ユニークな配列を作成
       For Each aCell In Rng.Cells
           If aCell.Value <> "" Then
              If Not Dic.Exists(aCell.Value) Then
                 Dic.Add aCell.Value, aCell.Value
              End If
           End If
       Next
       ' バブルソート
       buf = Dic.items
       For i = 0 To UBound(buf)
           For j = 1 To UBound(buf) - i
               If buf(j) < buf(j - 1) Then
                  swp = buf(j): buf(j) = buf(j - 1): buf(j - 1) = swp
               End If
           Next
       Next
       Rng2UniqSortAry = buf
    End Function
（ ´・ω・`） 2025/08/19(火) 17:02:16

コメント返信：

[ 一覧(最新更新順) ]

[[20250818150323]] 『VBAでオートフィルタで絞り込んでPDF化』（社会人） ページの最後に飛ぶ

[[20250818150323]]　『VBAでオートフィルタで絞り込んでPDF化』（社会人）　ページの最後に飛ぶ