PDF表データ→Excel表に変換(縦一列にコピーされてしまう場合)
お仕事などでお客さんからPDFで資料が送られてきて、
そのデータを基に仕事を進める際に、そのデータをExcelに写して
作業を進める事は多いのではないでしょうか？
・PDF表のデータをコピー、Excelに貼付けたら、データが縦一列に貼付けされた
・PDF表データは１セルも空白が無い状態だ
今回は↑の条件に当てはまる場合は
マクロ（VBA）を使用して元の配置に戻します。
ソースコードは記事上に記載しております。
『表のデータが縦一列に貼付けされる場合』とは具体的には
PDFの表部分をコピーして、Excelに貼り付けると、冒頭の画像のようになる場合です。
また再度注意点ですが、これからご紹介する方法では
【表がびっしり１セルも空白が無い場合にのみ】有効です。
空白がありますと、その部分はうまく表示されませんので、個別の対応(変換)が必要となります。空白が１～２か所程度ならば対応出来ると思いますが。
※PDF表のデータをコピー＆貼付けした際に、
表データが空白で区切られて表示されてしまう場合、
そんな場合は、こちらの記事がお役に立てるかと思います。
ちなみに、空白で区切られている場合は、あらかじめ準備しておいた数式を使って分離します。
それでは話をもとに戻して今回の場合のVBAを見て参りましょう。
VBAでデータをExcelに一発変換
上の画面を参考にし、
以下、VBAソースコード例を記載しておりますが、コードは２通り準備しました。
いずれも
・セル【B6】にPDF元データを貼り付けて
・並び直したデータは【E6】を右上端として
データを処理する仕様です。詳しくはすぐ上の画像をご覧ください。
１．PDF元データの表が【何列あるのか】を手入力でコードに直入力
Option Explicit
Sub From_PDf_to_Excel()
'画面STOP
Application.ScreenUpdating = False
Dim A As String
Dim WB1 As Workbook
Dim mySht1 As Worksheet
Dim i, cnt1, EndLine1, EndLine2, PDFRows As Long
A = "Test"
Set mySht1 = ThisWorkbook.Worksheets(A)
'★1
If mySht1.Range("B6") <> "" Then
'最終行確認
EndLine1 = mySht1.Range("B5").End(xlDown).Row
'PDFの列数入力
PDFRows = ▲▲ '←ここにPDFの列数を入力する
cnt1 = 6
EndLine2 = 1
'データ転記
For i = 6 To EndLine1
mySht1.Cells(cnt1, 4 + EndLine2).Value = mySht1.Cells(i, 2).Value
If EndLine2 < PDFRows Then
EndLine2 = EndLine2 + 1
Else
EndLine2 = 1
cnt1 = cnt1 + 1
End If
Next i
'★1終了
End If
'Restart Screen
Application.ScreenUpdating = True
End Sub
PDF資料のデータ表が何列あるか？を上のコードに
直接列数を入力してから、マクロを実行すると変換されます。
列数を入力する箇所は↑のソースコードの『２２列目部分【▲▲】』箇所に
「？列」の「？」部分の数字のみを記入して、マクロ実行です。
ソースコードの内容
★もしも【B6】が空白でなければ以下の事を実行する
・【B6】から下に向かって入力されているデータを
・【E6】→【F6】…といった順で右に１つずつズレながら転記していき、
・コード中の【▲】のPDF元データ列数まで来たら、１列下にスライドし
・再度【E列】→【F列】…といった具合に１列ずつズレながら転記する。
・【B6】からのデータが無くなり次第、動作を終了する。
こんな感じのコードです
２．Excel任意のセルにPDFの列数を入力し、そこを参照するようなコード
Option Explicit
Sub From_PDf_to_Excel()
'画面STOP
Application.ScreenUpdating = False
Dim A As String
Dim WB1 As Workbook
Dim mySht1 As Worksheet
Dim i, cnt1, EndLine1, EndLine2, PDFRows As Long
A = "Test"
Set mySht1 = ThisWorkbook.Worksheets(A)
'★1
If mySht1.Range("B6") <> "" And mySht1.Range("B2") <> "" Then
'最終行確認
EndLine1 = mySht1.Range("B5").End(xlDown).Row
'PDFの列数確認
PDFRows = mySht1.Range("B2").Value
cnt1 = 6
EndLine2 = 1
'データ転記
For i = 6 To EndLine1
mySht1.Cells(cnt1, 4 + EndLine2).Value = mySht1.Cells(i, 2).Value
If EndLine2 < PDFRows Then
EndLine2 = EndLine2 + 1
Else
EndLine2 = 1
cnt1 = cnt1 + 1
End If
Next i
'★1終了
End If
'Restart Screen
Application.ScreenUpdating = True
End Sub
↑のソースコードではセル【B2】に「？列」の「？」部分の数字のみを記入して、
マクロ実行！といった具合です。具体的には↓の画像を参考にしてください。
コードの内容的なお話で、どんな指示がなされているかと申しますと、
ソースコードの内容
★もしも【B6】と【B2】が空白でなければ以下の事を実行する
・【B6】から下に向かって入力されているデータを
・【E6】→【F6】…といった順で右に１つずつズレながら転記していき、
・【B2】のPDF元データの列数まで来たら、１列下にスライドし
・再度【E列】→【F列】…といった具合に１列ずつズレながら転記する。
・【B6】からのデータが無くなり次第、動作を終了する。
こんな感じのコードです。
基本的には１のモノと一緒です。
両方とも、もしも元データの記載がなければ
VBAでの処理が行われない仕様になっております。
以上になります。
いかがだったでしょうか？
解決出来て、業務の効率化、時短につながれば幸いです。