質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

Q&A

解決済

1回答

1423閲覧

複数の調査票(エクセル)の集約

natori

総合スコア19

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

0グッド

0クリップ

投稿2021/12/28 10:51

エクセルで調査票を作成しました。
複数部署からその調査票で回答が来るため、回答を集約するマクロを作成しているのですが、
ループの部分がおかしいようで、いくつかの問題が生じています。

①各調査票の5行目以降の回答ではなく、「5行目+前の調査票の回答行」番目の行を集約してきてしまいます。
②各調査票の右端の、最終列の項目まで取得したいのに、取得できません。
③各調査票について、集約のマクロを起動すると、すべての調査票が開き、「●●エクセルに変更を加えます」とポップアップが出てしまいます。単純に回答列だけ集約したいので、変更は入らないようにしたいです。

修正したいので、お力を貸してください。

VBA

1Public Sub MainProc() 2 Dim shtMain As Worksheet 3 Dim folderPath As String 4 Dim shtName As String 5 Dim dataStartRow As Long 6 Dim nowRow As Long 7 Dim shtTaisyo As Worksheet 8 Dim shtSyuyaku As Worksheet 9 Dim ext As String 10 Dim wb As Workbook 11 Dim lastRow As Long 12 Dim lastCol As Long 13 Dim fso As Object 14 Dim f As Object 15 16 '①「メイン」シートを変数に格納する 17 Set shtMain = ThisWorkbook.Sheets("メイン") 18 19 '②対象フォルダを変数に格納する 20 folderPath = shtMain.Range("A2") 21 22 '③シート名を変数に格納する 23 shtName = shtMain.Range("B2") 24 25 '④データ開始行を変数に格納する 26 dataStartRow = shtMain.Range("C2") 27 28 '⑤集約データ開始行を変数に格納する 29 nowRow = shtMain.Range("D2") 30 31 '⑥「集約データ」シートを変数に格納する 32 Set shtSyuyaku = ThisWorkbook.Sheets("集約データ") 33 34 '⑦「集約データ」シートの開始行以下をクリアする 35 shtSyuyaku.Rows(nowRow & ":" & shtSyuyaku.Rows.Count).Clear 36 37 '⑧FileSystemObjectを変数に格納する 38 Set fso = CreateObject("Scripting.FileSystemObject") 39 40 '⑨対象フォルダに存在するファイル数分処理する 41 For Each f In fso.GetFolder(folderPath).Files 42 43 '⑩ファイルの拡張子を変数に格納する 44 ext = LCase(fso.getextensionName(f.Name)) 45 46 '⑪拡張子が「xlsx」のみ処理を行う 47 If ext = "xlsx" Then 48 49 '⑫対象ブックを開く 50 Set wb = Workbooks.Open(folderPath & "\" & f.Name) 51 52 '⑬対象シートを変数に格納する 53 Set shtTaisyo = wb.Sheets(shtName) 54 55 '⑭対象シートの最終行を取得する 56 lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row 57 58 '⑮対象シートの最終列を取得する 59 lastCol = shtTaisyo.Cells(1, shtTaisyo.Columns.Count).End(xlToLeft).Column 60 61 '⑯対象シートの対象データを集約シートにコピーする 62 shtTaisyo.Range(shtTaisyo.Cells(dataStartRow, 1), shtTaisyo.Cells(lastRow, lastCol)).Copy _ 63 (shtSyuyaku.Cells(nowRow, 1)) 64 65 '⑰次の貼り付け行を計算する 66 nowRow = nowRow + lastRow - (dataStartRow - 1) 67 68 '⑱対象ブックを閉じる 69 wb.Close 70 71 '⑲メモリを解放する 72 Set wb = Nothing 73 74 End If 75 Next 76 77 MsgBox "完了" 78End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

とりあえずこんな感じでどうでしょうか。

VBA

1 '⑭対象シートの最終行を取得する 2 lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row 3 4 '⑮対象シートの最終列を取得する 5 lastCol = shtTaisyo.Cells(dataStartRow, shtTaisyo.Columns.Count).End(xlToLeft).Column 6 7 '⑯対象シートの対象データを集約シートにコピーする 8 Dim rng As Range 9 Set rng = shtTaisyo.Range(shtTaisyo.Cells(dataStartRow, 1), shtTaisyo.Cells(lastRow, lastCol)) 10 Debug.Print rng.Address 11 12 shtSyuyaku.Cells(nowRow, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 13 14 '⑰次の貼り付け行を計算する 15 nowRow = nowRow + rng.Rows.Count 16 17 '⑱対象ブックを閉じる 18 wb.Close False 19 20

投稿2021/12/28 12:36

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

natori

2022/01/04 02:41

解決しました!ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問