Excelのマクロについて教えて下さい。

画像

Excel | Visual Basic33閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

0
画像

ThanksImg質問者からのお礼コメント

いつも回答頂き、ありがとうございます。 一番希望していた形の結果が得られました。感謝いたします。

お礼日時:1/25 15:00

その他の回答(2件)

0

新規ブックにコピーされます。 対象のブックのフォルダーは★、拡張子は◆のところを変更してください。 Sub sample() Dim xFile As String, sh0 As Worksheet, i As Long, sh As Worksheet Const cFld As String = "C:\HogeHoge\Hoge1\SAMPLE\" '★ Const cExt As String = "*.xlsx" '◆ Application.ScreenUpdating = False Set sh0 = Worksheets.Add i = 1 xFile = Dir(cFld & cExt) Do While xFile <> "" With Workbooks.Open(cFld & xFile) For Each sh In .Worksheets With sh sh0.Cells(i, 1).Resize(, 2).Value = Array(.Range("A2").Value, .Range("C1").Value) With .Range("A4").CurrentRegion .Copy sh0.Cells(i, 3) i = i + .Rows.Count End With End With Next sh .Close False End With xFile = Dir Loop With sh0.Range("A1").CurrentRegion .Borders.LineStyle = True .EntireColumn.AutoFit .Parent.Move End With Application.ScreenUpdating = True End Sub

回答ありがとうござます! やってみたところボタンを設置したSheet1と何もデータの入っていないsheet2が消え、新たにsheet3が作られ、そこに集約された形になったのですが、 例えばsheet1にマクロのボタンを設置し sheet2に集約された結果が表示されるようにするには どうすれば良いのでしょうか?

0

こんな感じです。コード長くなりました。 使う前の準備 ①[Microsoft Scripting Runtime]を参照設定してください。 ②データのあるフォルダを指定してください。 備考 ①配列数は100×20を設定しています。過不足がある場合は修正してください。分からない場合はそのままお使いください。 機能 ①指定フォルダ内の[.xlsx]ファイルをすべて処理します。 ※[.xlsx]を[.xls*]としてもかまいません。 ②ファイルのデータは全て配列に格納しています。 ③「NO」と「送付先」だけのデータの場合は、その2つだけを転記します。それ以外は全て出力します。 ④出力先はマクロファイルのSheet1です。 Sub test() Dim mypath As String Dim fso As New FileSystemObject Dim fl As Folder Dim f As File Dim wb As Workbook Dim ws As Worksheet Dim ary Dim ar As Variant, br As Variant Dim i, j, k, l As Long Dim m, n, p, q As Long Dim r, x As Long Application.ScreenUpdating = False Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") ar = Array("A2", "C1") 'データ取得先配列 br = Array("A", "B", "C") 'データ取得先配列 mypath = "C:\Users\○○\Desktop\△△" '##### データのあるフォルダを指定 ##### Set fl = fso.GetFolder(mypath) ReDim ary(100, 20) '## 配列(100行×20列分) ## m = 1 n = 1 For Each f In fl.Files If f.Name Like "*.xlsx" Then '[.xlsx]ファイルを対象(*.xls*でも良い) Workbooks.Open (f) r = Cells(Rows.Count, 1).End(xlUp).Row x = (r - 3) * 3 + 2 'コマ数制御 'データを配列格納(2次元) For i = 0 To UBound(ar) ary(m, n) = Range(ar(i)) n = n + 1 Next i For j = 0 To r - 4 For k = 0 To UBound(br) ary(m, n) = Range(br(k) & 4 + j) n = n + 1 If n > x Then Exit For Next k Next j m = m + 1 n = 1 ActiveWorkbook.Close End If Next '出力 wb.Activate With ws p = 0 '出力行数 q = 3 '3列目出力固定 For i = 1 To UBound(ary, 1) If ary(i, 1) = "" Then Exit Sub '[NO][送付先]出力 For j = 1 To 2 Cells(i + p, j) = ary(i, j) If j = 2 And ary(i, 3) = "" Then p = p + 1 Next j 'その他出力 l = 3 For k = 3 To UBound(ary, 2) If ary(i, l) = "" Then Exit For End If For l = k To UBound(ary, 2) Step 3 If ary(i, l) = "" Then Exit For Cells(i + p, q) = ary(i, l) Cells(i + p, q + 1) = ary(i, l + 1) Cells(i + p, q + 2) = ary(i, l + 2) p = p + 1 Next l Next k p = p - 1 Next i End With Application.ScreenUpdating = True End Sub

回答ありがとうございます!出来ました!! ただ、ボタンを設置したシートと集約した結果を 別シートにして分けたい場合はどうすればよいのでしょうか? ボタン設置をシート1、 結果をシート2に表示させたいです。