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

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

ただいまの
回答率

88.19%

エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。

受付中

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 232

enoko

score 1

エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。
VB歴が浅いためひらめきません。よろしくお願いします。

Sub まとめ()

'変数を宣言
Dim i
Dim j
Dim k
Dim n

'セルに値が存在する数を変数nに代入
n = Cells(Rows.Count, "A").End(xlUp).Row

'シート1から31までを繰り返す処理
For j = 1 To 31

    '5からセルの値が空になるまでループする処理
    For k = 5 To n

        '5行目から順に入力される処理
        For i = 5 To Sheets("まとめ").Range("A10000").End(xlUp).Row + 1

            '["A" & i]が空白のときに実行される
            If Sheets("まとめ").Range("B" & i).Value = "" Then

                '入力されているセルを「まとめ」シートに移動する
                Sheets("まとめ").Range("A" & i).Value = j
                Sheets("まとめ").Range("B" & i).Value = Sheets(j).Range("A" & k).Value
                Sheets("まとめ").Range("D" & i).Value = Sheets(j).Range("C" & k).Value
                Sheets("まとめ").Range("F" & i).Value = Sheets(j).Range("E" & k).Value
                Sheets("まとめ").Range("H" & i).Value = Sheets(j).Range("G" & k).Value
                Sheets("まとめ").Range("I" & i).Value = Sheets(j).Range("H" & k).Value
                Sheets("まとめ").Range("J" & i).Value = Sheets(j).Range("I" & k).Value
                Sheets("まとめ").Range("K" & i).Value = Sheets(j).Range("J" & k).Value

            End If

        Next

    Next

Next

End Sub
コード
  • 気になる質問をクリップする

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • meg_

    2021/01/21 14:03

    > エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。
    現状の課題は何でしょうか?質問のコードを実行するとどのような結果となるのでしょうか?

    キャンセル

  • enoko

    2021/01/21 14:24

    コードを実行すると空白のままで実行前と結果が変わらない状況です。
    まずは実行結果が表示されるところまでできればいいと思っています。

    キャンセル

回答 2

0

少し触ってみましたが気になる点を複数点

'セルに値が存在する数を変数nに代入
n = Cells(Rows.Count, "A").End(xlUp).Row


このタイミングでworksheetの指定がありません。
そのためactivesheetでの参照になっていると思われます。
また、値を取得するタイミングがforループの中に組み込まれていないため、この値は初回に取得すると更新されません。

'シート1から31までを繰り返す処理
For j = 1 To 31

と書いていますがWorksheets(j)といった記述が一切ないためsheet1からsheet31を参照していません。
この下にn = worksheets(j).Cells(Rows.Count, "A").End(xlUp).Rowと書けば動きはしますが、この場合はシートの順番で指定になるのでfor Eachで全シート巡回した方が想定外の動きになりません。
(一番左端にまとめがあったり勝手にシートを動かされたりするとバグる)

    '5からセルの値が空になるまでループする処理
    For k = 5 To n


最初の点に記載があるようにアクティブシートのA列を一回だけ参照しているため、例えばnの値が1であればループの中に入らずそのまま終了します。

        '5行目から順に入力される処理
        For i = 5 To Sheets("まとめ").Range("A10000").End(xlUp).Row + 1


Range("A10000")と書いてあるので末尾を取得したいのだと思いますが、Rows.Countなら正確な末尾を取得します。(一行目で使用しています)
2007以降なら1048576、2003なら65536になります。

[追記]
セルの指定はRange("A"&i)みたいなA1形式よりもCells(1,i)みたいなR1C1形式の方が使いやすいので慣れた方がいいです。
Range(cells(1,1),Cells(3,1))で複数範囲も指定できます。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

Sub test()
    Dim wshResult As Worksheet
    Dim rngCopyFrom As Range
    Dim ixRow As Long
    Dim i As Long, j As Long

    Set wshResult = Worksheets("まとめ")
    ixRow = 2

    For i = 1 To 3
        '各シート転記元のセル範囲の取得
        With Worksheets(i).UsedRange
            Set rngCopyFrom = Application.Range(.Range("A5"), .Cells(.Cells.Count))
        End With
        'コピー元の行数を数える
        j = rngCopyFrom.Rows.Count

        '列毎の転記
        With wshResult.Cells(ixRow, 1).Resize(j)
            .Columns("A").Value = Worksheets(i).Name
            .Columns("B").Value = rngCopyFrom.Columns("A").Value
            .Columns("D").Value = rngCopyFrom.Columns("C").Value
            .Columns("F").Value = rngCopyFrom.Columns("E").Value
            .Columns("H").Value = rngCopyFrom.Columns("G").Value
            .Columns("I:K").Value = rngCopyFrom.Columns("H:J").Value
        End With

        '次の転記先行番号の用意
        ixRow = ixRow + j
    Next
End Sub

For ~ Nextを入れ子にしてインデックス番号をごねごね作って、
ぐるぐるループするとわけわかんなくなりますよね。

一括でできるところは一括でまとめて、
セルの読み書きの回数をできるだけ少なくすることで、
読みやすくなるし、処理の高速化も見込めます。

そのためには、セル範囲の表現方法を学ぶとともに、
「オブジェクト変数」を上手く使えるようになるとよいかと思います。

あと、複数シートを扱う場合は、
どのシートの話かも明示する必要があります。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

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

  • ただいまの回答率 88.19%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • トップ
  • VBAに関する質問
  • エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。