締切済み

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

  • すぐに回答を!
  • 質問No.9610219
  • 閲覧数131
  • ありがとう数0
  • 気になる数2
  • 回答数3
  • コメント数0

お礼率 0% (0/3)

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

回答 (全3件)

  • 回答No.3

ベストアンサー率 28% (4477/15939)

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

ベストアンサー率 59% (196/329)

Excel(エクセル) カテゴリマスター
提示されたコードを限りなく生かしながら
動作するように加筆してみました。

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

なお、
  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

ベストアンサー率 44% (95/213)

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

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

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

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

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

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

このようにして「何かよく分からないけど動かない」から「△△のような動きになり、○○の部分がおかしいようだが、修正の仕方が分かりません」にまで分解できれば、有効な回答がつきやすくなり、そのうちに勝手に技術もつきます。
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

ピックアップ

ページ先頭へ