ここから本文です

ExcelのVBAに関する質問です。 先方から大量に送られて来るデータ(Excelファイ...

pia********さん

2018/11/721:29:53

ExcelのVBAに関する質問です。

先方から大量に送られて来るデータ(Excelファイル)を1つのフォルダに入れ、別の集計用ファイルにまとめたいと思っています。

ただ1つのシートに集計するのではなく、集計用シートは種類別にシートが分かれております。

送られてくるデータと、集計用ファイルの形式(見た目)が違うため、そのままコピーするのではなく、必要な部分を必要なだけ集計用ファイルにコピーしたいのです。

例えば、元データの「R3」を集計用の「C14」へコピー&貼り付けなどです。(コピーしたい部分はたくさんありますが、1つ分かれば、残りは自分で加工します)


そして先方のファイルは、シートが複数存在し(ファイルごとによって異なります)、シートによって、複数種類があります。
その種類は、各シートのA1に記載されております。

例えば、元データのA1に「みかん」が含まれる文字列が入っていた場合、必要データを集計用ファイルの「みかん」シートに貼り付けていきたいという訳です。(完全一致ではなく、含まれる場合がよいです)

集計用ファイルには、予め貼り付け用シート(複数種類分)を作成してあります。


集計用のデータは、横一列に貼り付けていくような形式になっておりまして、集計表の開始行は各シート13行目です。

その13行目から、種類別で必要な項目のみ貼り付けていきたいという質問です。


※要点を再度記載します。
・「テスト」フォルダ内に先方から送られてきたExcelファイルが大量にあり、それを集計用.xlsmファイルに必要な部分だけを貼り付け、集計したい

・シートの項目は複数種類があり、A1の文字列から種類を判別し、該当するシートに貼り付けていく

・13行目から集計表が始まっているため、13行目から種類を分けながら貼り付けていく
・「テスト」フォルダの中のExcelファイル、上から下まで作業を行う

以上となります。


付随してになりますが、1か所、元データの様式が方眼紙のようになっている部分があり、M1セル~P1セルまでに1文字ずつ文字が入っている場所があります。
これを1つの指定したセルに貼り付ける方法はありますでしょうか?

「あ」「い」「う」「え」 を 「あいうえ」と貼り付けたいという事です。



長くなってしまい申し訳ありません。
皆様のお力をどうかお貸しいただけないでしょうか。

不明な点は全て返信でお答えします。
よろしくお願いします。

閲覧数:
167
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

kky********さん

編集あり2018/11/810:06:39

変更コードです。

Sub Sample()
Const fpath As String = "C:\test\"
Dim fname As String
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim sname() As Variant
Dim i As Long
Dim j As Integer
Dim tbl1 As Variant
tbl1 = Array("B4", "R4", "O32", "N12", "N13", "N14", "N15", "N16", "N25", "N26", "N27")
Dim tbl2 As Variant
tbl2 = Array("E", "C", "F", "G", "H", "I", "J", "K", "M", "N", "O")
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
'シート名配列に
i = -1
For Each sh1 In wb1.Worksheets
i = i + 1
ReDim Preserve sname(i)
sname(i) = sh1.Name
Next sh1
'各ブック処理
fname = Dir(fpath & "*.xlsx", vbNormal)
Do Until fname = ""
Set wb2 = Workbooks.Open(fpath & fname)
For Each sh2 In wb2.Worksheets
With sh2
'集計シート設定
For i = 0 To UBound(sname)
If InStr(.Range("A2").Value, sname(i)) > 0 Then
Set sh1 = wb1.Worksheets(sname(i))
i = sh1.Cells(Rows.Count, "C").End(xlUp).Row
Exit For
End If
Next i
'転記
i = i + 1
For j = 0 To 10
sh1.Range(tbl2(j) & i).Value = .Range(tbl1(j)).Value
Next j
sh1.Range("D" & i).Value = .Range("M4").Value & .Range("N4").Value & .Range("O4").Value & .Range("P4").Value
End With
Next sh2
wb2.Close
fname = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "データ転記終了"
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

ベストアンサー以外の回答

1〜1件/1件中

よこまやさん

2018/11/721:55:13

当然これって、お仕事ですよね。
まず、最初に理解いただきたいのは、誰かにコードを教わったところで、責任は貴方が取らないといけないので、そのコードを掌握する能力は問われる覚悟をお持ちですか?
でないと、答弁にあたふたしてたどっかの大臣みたいな立場に陥いる恐れがあります。

これはそれなりに規模のあるコードになると思いますから、全貌を一気に追うのではなく、まずひとつのタイプだけで、集計を確立して、その応用で他のタイプに水平展開、というような段階を踏んで進めるのが、適切ではないかと。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる