大量のエクセルの共通項目を一つのエクセルにまとめる

質問

Windows10のoffice2016を使用しています。
マクロ初心者です。
仕事でエクセルファイルのデータ整理をしなければいけないのですが、コピー元のエクセルファイルが千単位であり、手作業だと時間がかかりすぎるため、VBAでマクロが動かなくて困っています。調べながら書いておりますが、なぜ動かないかわかっておりません。
コピー元の多くのエクセルファイルと貼付先の一つのエクセルファイルがあります。
コピー元のエクセルファイルは、”計算フォルダ”というフォルダに入っており、
その各々のファイルには、“仕様””日時””用途”とその右隣には値が入力されています。
行いたいことは、
コピー元のファイル内の”仕様””日時””用途”をFindで探して、その隣の値をコピーして、貼付先のエクセルファイルの”貼付先1”というシートに、順に貼付けすることです。
皆さまのお知恵をどうか貸してください。よろしくお願いします。

Sub 取り込みマクロ()
Dim objFSO As Object
Dim objBook As Object
Dim n As Long
Dim rngSearch1, rngSearch2, rngSearch3, varSearch
Dim myRange As Range
Dim FolderPath As String

FolderPath = ThisWorkbook.Path & "\計算フォルダ"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objBook In objFSO.GetFolder(FolderPath).Files
n = ThisWorkbook.Sheets("貼付先1").Cells(Rows.Count, "A").End(xlUp).Row + 1
Workbooks.Open objBook.Path
Worksheets("コピー元").Activate
Set rngSearch1 = .Worksheets("コピー元").Find("仕様")
Set rngSearch2 = .Worksheets("コピー元").Find("日時")
Set rngSearch3 = .Worksheets("コピー元").Find("用途")

If rngSearch1 Is Nothing Then
Else
rngSearch1.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("B" & 1 + n)
End If
If rngSearch2 Is Nothing Then
Else
rngSearch2.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("C" & 1 + n)
End If
If rngSearch3 Is Nothing Then
Else
rngSearch3.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("D" & 1 + n)
End If

With Rows("185").Copy
ThisWorkbook.Sheets("貼付先1").Rows(n).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
End With
On Error Resume Next
Next
Set objFSO = Nothing
MsgBox "完了！"
End Sub

回答No.3

imogasi

>Findでさがして
これでは処理に時間がかかると思う。
ーー
Excelでなくて、多量データ処理に強いデータベースソフトや他のRDBソフトの利用を考える。（　他ソフトとエクセルデータの交互の行き来は、エクセルが流行っているので、簡単な方法が用意されていると思われるが）
こんな長々と自己流のコードを掲げる前に、「構想」そのものの是非や、他によさそうな方法を、ベテランや経験者やソフト業者に聞くべきだと思う。
「構想」とは（コーディングの前にあるもので）
（１）本件に適した、何か使うソフトの特定の便利な機能の利用がないか
（２）データのJoinで２つ以上のデータ群を紐づける
（３）ソートとマージやマッチングで、２つ以上のデータ群を紐づける
（４）（２），（３）にも関係するが、SQLを使いこなす
（５）Addinソフトなどを既製ソフトを探す。「適当なのがあれば」のはなしだが。
例　本件と関係ないが、例示
https://freesoft-100.com/pasokon/office-utility.html
「複数の Excel シートを一括比較できる差分比較ツール」のように、特化した
ソフト。
などのことを、小生は言っている。
課題に合わせてソフトと機能を選ばないと、エクセルの世界だけで、言っていては、だめだと思う。プロはエクセルをメインにして、システムを構築するでしょうか？想像して、または尋ねてみてください。

回答No.2

HohoPapa

提示されたコードを限りなく生かしながら
動作するように加筆してみました。

比較することで多少なりとも勉強になるかもしれません。

なお、
　　With Rows("185").Copy
　　　ThisWorkbook.Sheets("貼付先1").Rows(n).PasteSpecial
このコードの意味するところが分からないので
コメントアウトしました。

Option Explicit

Sub 取り込みマクロ()
　Dim objFSO As Object
　Dim objBook As Object
　Dim n As Long
　Dim rngSearch1 As Range
　Dim rngSearch2 As Range
　Dim rngSearch3 As Range
　Dim varSearch As Range
　Dim myRange As Range
　Dim FolderPath As String

　Dim FromBook As Workbook

　FolderPath = ThisWorkbook.Path & "\計算フォルダ"
　Set objFSO = CreateObject("Scripting.FileSystemObject")
　n = ThisWorkbook.Sheets("貼付先1").Cells(Rows.Count, "A").End(xlUp).Row + 1

　For Each objBook In objFSO.GetFolder(FolderPath).Files

　　Set FromBook = Workbooks.Open(objBook.Path)

　　Set rngSearch1 = FromBook.Worksheets("コピー元").Cells.Find("仕様")
　　Set rngSearch2 = FromBook.Worksheets("コピー元").Cells.Find("日時")
　　Set rngSearch3 = FromBook.Worksheets("コピー元").Cells.Find("用途")

　　If rngSearch1 Is Nothing Then
　　Else
　　　'rngSearch1.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("B" & 1 + n)
　　　rngSearch1.Offset(0, 1).Copy ThisWorkbook.Sheets("貼付先1").Range("B" & 1 + n)
　　End If

　　If rngSearch2 Is Nothing Then
　　Else
　　　rngSearch2.Offset(0, 1).Copy ThisWorkbook.Sheets("貼付先1").Range("C" & 1 + n)
　　End If

　　If rngSearch3 Is Nothing Then
　　Else
　　　rngSearch3.Offset(0, 1).Copy ThisWorkbook.Sheets("貼付先1").Range("D" & 1 + n)
　　End If

　　With Rows("185").Copy
　　'　ThisWorkbook.Sheets("貼付先1").Rows(n).PasteSpecial　 '??何？
　　　Application.CutCopyMode = False
　　　ActiveWorkbook.Close SaveChanges:=False
　　End With
　　n = n + 1
　 On Error Resume Next
　Next
　Set objFSO = Nothing

　MsgBox "完了！"

End Sub

回答No.1

kon555

うーん、コード自体に怪しいところがゴロゴロあるので「これが正しいコードですよ」とパッと提示はできそうにないです。

なのでちょっと迂遠ですが、「マクロが動かないとき」の対処方法を回答させていただきます。
そもそも『コピー元のエクセルファイルが千単位であり』という業務環境であれば、このコード1つ正しくなるより余程有益だと思うので。

まず第一に、「動かなくて困っています」をもっと具体的に書きましょう。
そもそも起動したらエラーが出るのか、エラーは出ないけど思った結果にならないのか。エラーが出るならエラーのメッセージを、思った結果にならないなら「どうなるのか」を把握しましょう。

次に、デバッグの基本はf8キーなどのステップイン挙動です。一行ずつ実行されるので、どの部分がおかしいのかが詳細に把握できます。

続いて、マクロを幾つかに分解してみるのもいいでしょう。
今回の貴方の場合は「指定したブックを開いて」「語句を検索して」「コピーして」「貼り付け先ブックの指定シートに」「貼り付けて」「コピー元ブックを閉じる」と、中々複雑な動作になっています。

まず一つずつ分解して、「指定したブックを開く部分」「語句を検索する部分」と分けて、自分で一度マクロを組んでみましょう。
この程度であれば自動記録も十分参考になりますし、個々の動きであればサンプルになるマクロはwebに転がっているはずです。
そうすると、「○○の機能がよく分からない」のか「個々の機能単位なら動くのにまとめると変になる」のかが分かります。

このようにして「何かよく分からないけど動かない」から「△△のような動きになり、○○の部分がおかしいようだが、修正の仕方が分かりません」にまで分解できれば、有効な回答がつきやすくなり、そのうちに勝手に技術もつきます。