戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
ループ処理の考え方について

    [191483] ループ処理の考え方について-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/24(16:14))
    □U R L/
      いつも大変お世話になっております。
      
      インデックスシールへの印刷の為に、リストからページレイアウトしたシートのセルに値を転記させています。
      値は、
      A1=C1、A2=C2 〜A6=C6
      E1=G1、E2=G2 〜E6=G6
      と続いて、7列目の Y6=AA6 までが、1ページとなっています。
      B列はA1とC1の文字の間のスペース。D列は、シールとシールの間のスペース。
      
      転記元データは、同じシートのA7〜A12セルで65列程度(増減あり)。
      問題は、AA列とAB列の間には空白行が無いので、どうやってデータ転記のループを組むかです。
      現状は、データ転記は、1列おきに繰り返し、AA列の次の空白列、つまり28列を削除してそれを最終列まで27列ごとに繰り返しています。
      
      これだと、データ転記するたびに、28列目からを削除してしまうことになり、別のプロシージャで設定した列幅の設定と同じようになりません。
      
      28列目を削除することなく、1ページ分のデータ転記をページ数分ループさせることは可能でしょうか?
      宜しくお願いします。
      
      
      以下、現状のコードになります。
      
      Sub 印刷用シートへ転記02()
      
          Dim i As Long, j As Long, k As Long, wsL As Worksheet, wsP As Worksheet, LmaxRow As Long, m As Long
          Dim PmaxRow As Long, n As Long, maxCol As Long, s As Long, c As Long
          
          Debug.Print Time & " - スタート"
          
          Application.ScreenUpdating = False      '画面更新を停止
          Set wsL = Worksheets("リスト")
          Set wsP = Worksheets("印刷用")
          
          LmaxRow = wsL.Range("B65536").End(xlUp).Row     'リストシートのB列の最終行を取得
          i = 1
          j = 1
          k = 6
          m = 1
      
              Do While i <= k         '   i が k になるまで繰り返す
                      wsP.Cells(m, j).Value = wsL.Cells(i, 2).Value       '  1回目は 印刷用シートA1セルにリストシートB1セルを転記、2回目は印刷用シートA2セルにリストシートB2セルを転記を6回繰り返す
                      i = i + 1
                      m = m + 1
                  Loop
      
              Do While i <= LmaxRow           '   リストシートの最終列まで繰り返す
      
                      Do While i <= k - 1
                          wsP.Cells(m, j).Value = wsL.Cells(i, 2).Value   '上記転記を繰り返す
                          i = i + 1
                          m = m + 1
                      Loop
              m = 1
              j = j + 1
              k = i + 6
              Loop
              
          Debug.Print Time & " - 印刷シートへの転記終了"
              
      '----------印刷用シートの各セルを転記---------------------------------------
          Debug.Print Time & " - 印刷シート内での転記開始"
              wsP.Activate
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   印刷用シートに転記した1行目の最終列を取得
              wsP.Range(wsP.Cells(7, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Value      '印刷用シートの1~6行の最終列までの値を、印刷用シートA7セルに転記
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Clear              '   印刷用シートの1~6行の最終列までの値をクリア
              
              
              j = wsP.Range("XFD7").End(xlToLeft).Column          '7行目の最終列を取得
              
                  For i = 1 To j
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value   '   7行目以降のA列のデータを1行目に転記、7行目以降のB列のデータを1列おきに転記していく
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得     転記を繰り返す処理なのでループごとに最終列が変化するから
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value    '転記したデータを2列右側へ値を転記
                  Next
                  
                  maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                  
                  
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 3), wsP.Cells(12, maxCol)).Value
              wsP.Range(wsP.Cells(1, maxCol - 3), wsP.Cells(12, maxCol)).Clear
              
                  For n = 28 To maxCol Step 27                                                '   レイアウト設定のうえで、不必要な空白列を最終列まで削除
                      wsP.Cells(1, n).EntireColumn.Delete
                  Next
              wsP.Rows("7:12").Clear
          Debug.Print Time & " - 印刷シート内での転記終了"
      '---------------------------------------------------------------------------
      
      
      '----------行挿入と行の高さ調整---------------------------------------------
          Debug.Print Time & " - 行調整開始"
              
          PmaxRow = wsP.Range("C1").End(xlDown).Row           '   最終行を取得
          wsP.Rows(1 & ":" & PmaxRow).EntireRow.RowHeight = 63.75        '   1行目から最終行までのの高さを63.75に変更
          
              For n = PmaxRow To 2 Step -1
                  wsP.Cells(n, "A").EntireRow.Insert          '   最終行から2行目まで、1行おきに行挿入
                  wsP.Cells(n, "A").EntireRow.RowHeight = 39.75   '   挿入した行の高さを39.75に変更
              Next
          
          Debug.Print Time & " - 行調整終了"
         
         
      '----------セルの書式設定---------------------------------------------
          Debug.Print Time & " - セルの書式設定"
          
              i = wsL.Range("D4").Value \ 42      'リストシートのD4セルのリスト数から処理列数を変数iに代入
              i = i * 30
              wsP.Rows("1:11").Orientation = xlVertical      '   セルの書式設定 縦書き
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, i)).ShrinkToFit = True        '    セルの書式設定 縮小して表示
              wsP.Rows("1:11").Font.Size = 9      '   フォントサイズ変更
      
          Debug.Print Time & " - 終了"
      '---------------------------------------------------------------------------
          wsP.Range("A1").Select
          Application.ScreenUpdating = True       '   画面更新を再開
      
      
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191487] Re[1]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/02/24(16:44))
    □U R L/
      | 転記元データは、同じシートのA7〜A12セルで65列程度(増減あり)。
      | 問題は、AA列とAB列の間には空白行が無いので、どうやってデータ転記のループを組むかです。
      すみません、にわかには理解できません。
      
      「転記元と転記先の対応関係」を明示的に書いて下さい。
      折角例示しているのですから、
      転記元セル  転記先セル
      A7          A1
      ・・・
      のように。
      
      あなたはもちろん理解しているんでしょうけど、
      一番肝心なところが書かれていません。
      
      申し訳ないが、コードは一切見ていません。
      コードではなく、日本語できちんと説明してください。(すべてでなくて結構)
      




    [191491] Re[2]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/02/24(18:00))
    □U R L/
      こういう事だろうか。。。。
      
      Sub test()
          Dim rngFrom As Range    '元データセル範囲
          Dim rngTo As Range      '転記先セル範囲(印刷用)
          Dim ixFrom As Long      '元データ列番号
          Dim ixTo As Long        '転記先列番号
          Dim i As Long           '列番調整用
          
          With Worksheets("リスト")
              Set rngFrom = Application.Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
          End With
          Set rngTo = Worksheets("印刷用").Range("A1:A6")
          
          ixTo = 1
          For ixFrom = 1 To rngFrom.Columns.Count Step 2
              rngTo.Columns(ixTo).Value = rngFrom.Columns(ixFrom).Value
              rngTo.Columns(ixTo + 2).Value = rngFrom.Columns(ixFrom + 1).Value
              
              ixTo = ixTo + 4
              i = i + 1
              If i > 6 Then
                  ixTo = ixTo - 1
                  i = 0
              End If
          Next
      End Sub
      
      コードを読んだら分かると思っているかも知れないけど、
      何をしようとしているか解んないです。
      
      個々のセルではなく、特定のセル範囲に対しての相対的な位置を
      示すとわかりやすいかと思います。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191493] Re[3]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/24(18:17))
    □U R L/
      γさん
      まっつわんさん
      
      説明不足ですいませんでした。
      したい事は、下の図表の通りです。
      
      転記元	転記先	転記先2
      A7	A1	C1	
      A8	A2	C2
      A9	A3	C3
      A10	A4	C4
      A11	A5	C5
      A12	A6	C6
      
      A7〜A12の値をA1〜A6およびC1〜C6へ転記する。
      同じようにB7〜B12をE列とG列に転記していきます。これを、7〜12行の最終列(ここが増減する)まで繰り返します。
      C列は、転記でもコピー
      
      
      
      	A	B	C	D	E	F	G	H	I	J	K
      1	〇		〇		100		100		◇		◇
      2	×		×		200		200		◆		◆
      3	△		△		300		300		□		□
      4	▲		▲		400		400		■		■
      5	▽		▽		500		500		✖		✖
      6	●		●		600		600		▼		▼
      7	〇	100	◇
      8	×	200	◆
      9	△	300	□
      10	▲	400	■
      11	▽	500	✖
      12	●	600	▼
      
      現状のコードは、
      A7〜A12をC列に転記して(C列から転記したのは、A列からループさせられなかった為)、
      さらに転記した列から右に2列目(E列)にも同じA7〜A12を転記する。
      これを7〜12行の最終列まで繰り返す。
      転記はC列からのスタートなので、C列から最終列までのデータをA列を起点にして転記。
      最終列から3列の値をクリア。7〜12行の値をクリア。
      この後、ページレイアウトの都合で、28列目、55列目、72列目・・・と27列ごとに行削除を実行。
      
      これで、したいようなレイアウトでデータが入ります。
      しかし、データの転記を繰り返すと、列削除を実行してしまうので、列幅の調整プロシージャを実行しないといけなくなります。
      列削除をしないで上記図表のような転記が出来ればと思います。
      
      宜しくお願いします。




    [191495] Re[4]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/24(18:21))
    □U R L/
      追記です。
      
      コードの全ては、
      リストのシートから印刷用シートへ転記。
      さらに、印刷用シート内でレイアウトに合うように転記する。
      といったものです。
      
      >まっつわんさん
      ご提示頂いたコードを試してみます。
      
      修正したいコードは、最初に提示したコードの一部で、下記の部分になります。
      
      '----------印刷用シートの各セルを転記---------------------------------------
          Debug.Print Time & " - 印刷シート内での転記開始"
              wsP.Activate
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   印刷用シートに転記した1行目の最終列を取得
              wsP.Range(wsP.Cells(7, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Value      '印刷用シートの1~6行の最終列までの値を、印刷用シートA7セルに転記
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Clear              '   印刷用シートの1~6行の最終列までの値をクリア
              
              
              j = wsP.Range("XFD7").End(xlToLeft).Column          '7行目の最終列を取得
              
                  For i = 1 To j
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value   '   7行目以降のA列のデータを1行目に転記、7行目以降のB列のデータを1列おきに転記していく
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得     転記を繰り返す処理なのでループごとに最終列が変化するから
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value    '転記したデータを2列右側へ値を転記
                  Next
                  
                  maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                  
                  
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 3), wsP.Cells(12, maxCol)).Value
              wsP.Range(wsP.Cells(1, maxCol - 3), wsP.Cells(12, maxCol)).Clear
              
                  For n = 28 To maxCol Step 27                                                '   レイアウト設定のうえで、不必要な空白列を最終列まで削除
                      wsP.Cells(1, n).EntireColumn.Delete
                  Next
              wsP.Rows("7:12").Clear
          Debug.Print Time & " - 印刷シート内での転記終了"
      '---------------------------------------------------------------------------


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191502] Re[5]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/02/24(19:36))
    □U R L/

      >コードの全ては、
      >リストのシートから印刷用シートへ転記。
      >さらに、印刷用シート内でレイアウトに合うように転記する。
      >といったものです。

      なるほど、インデックスの表裏というイメージですね。

      ぼくはニチバンのインデックスで、ラベルメイトという専用アプリ使ってます。
      メーカーによって、それぞれ専用アプリがありそうなもんですけど、
      数をいっぱい使わないので、はがきの大きさの紙がちょうどいいのです。

      コクヨとかだと、A4版とかになっちゃうんですかね。。。

      で、何クッションも入れてようやく印刷シートに展開されてますが、
      元データから印刷用シートに直に転記してはいかがでしょう?
      まずはセル範囲の取得と、それからの相対位置の示し方を勉強されると
      いいと思いました。

      あと、7回で1セットなので、
      別途数を用意して数えて、7回になったらまた1から数え直すと、
      考え方が楽かなと思いました。





    [191505] Re[6]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/02/24(22:03))
    □U R L/
      # 外出から戻りました。(いちいち良いのですが)
      
      PopCultVenus さんの (2020/02/24(18:17))の説明ですけど、
      12行ある表は、どのシートの話なんですか?
      
      リストシートから印刷シートに転記するんですよね。
      出発点からしてよく分かりません。
      
      ・リストシートのレイアウトと、
      ・できあがりの印刷シートのレイアウト、
      を説明してもらえませんか?
      (追記:レイアウトは結構です。すでにコードが提示されていますし、
        私が貢献できることもなさそうです。)
      
      印刷シート内で転記するような話があるんですが、それは何故なんですか?
      そのあたりもよくわかりませんでした。
      ダイレクトにリストシートから印刷シートに転記してできあがりではないんですか?




    [191513] Re[7]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/25(06:06))
    □U R L/

      おはようございます。
      まっつわんさん
      γさん

      ありがとうございます。
      ご指摘の通り、ダイレクトに転記出来れば良かったのですが。

      リストシートのB1〜B390に転記したい元データがあります。

      これまで記述してきたのは、
      1、縦に並んだリストを6行×?列にしたかった為、印刷用シートのA1〜に転記
      2、転記した印刷用シートA1〜A6×?列に空白行を入れようとしたが、処理に時間が掛かる為
        1行おきに転記しなおす為に、A7以降に再度転記
      3、A7以降のデータを、1行おきにA1セルに入るように転記
      4、不要な空白行や値を削除

      でした。これを

      1、リストシートのB1〜B6セルを印刷用シートのA1セルとC1セルに転記
      2、リストシートのB7〜B12セルを印刷用シートのE1セルとG1セルに転記
      3、上記を7回繰り返す
      4、1〜3をデータ数だけ繰り返す

      という考え方でよいでしょうか。
      遠回りしてしまった理由としては、縦のリストを6行×?列に直す為にVBA講習で教わった
      3×3セルに1〜9を順番に入力するというものを思い出して記述してみました。
      そこからさらに処理が必要になったので、転記場所を移動して転記を繰り返して・・・

      これから仕事なので、日中に色々考えてみます。
      修正できるのは夜になってしまうかと思います。


      >まっつわんさん
      専用アプリがあれば探してみたいと思います。アプリがあっても、プロシージャは
      完成させたいと思います。




    [191515] Re[8]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ サンダー -(2020/02/25(09:38))
    □U R L/
      元データを6行おきに、印刷シート 2列ずつ横に貼り付け?でよいのかな
      
      Sub tes()
      Dim Lmax As Long
      Dim Trow As Long
      Dim Tcol As Long
      
      Set wsP = Sheets(1)
      Set wsL = Sheets(2)
      
      '転記先は
      '行は1から6
      '1行おきに、1アイテム2回ずつ横に配置
      LmaxRow = wsL.Range("B65536").End(xlUp).Row
      For i = 1 To LmaxRow
          Trow = ((i - 1) Mod 6) + 1
          Tcol = Int((i - 1) / 6)
          Debug.Print Trow, Tcol
          wsP.Cells(Trow, Tcol * 4 + 1).Value = wsL.Cells(i, 2).Value
          wsP.Cells(Trow, Tcol * 4 + 3).Value = wsL.Cells(i, 2).Value
      Next
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191517] Re[9]: ループ処理の考え方について-

    保留中です・・・ / 記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/25(21:01))
    □U R L/

      こんばんは。

      サンダーさん

      コードの提示、ありがとうございます。

      教えて頂いて申し訳ありませんが、もう少し自分であがいてみます。
      質問しておいて勝手かもしれませんが。
      教えて頂いたコードを実行させて思うような動作が得られても、自分の思考力が
      プラスにはならないと思うので。
      色々やってみて、それから教えて頂いたコードを実行してみます。
      サッと読んだだけで、コードが理解できる力もありませんので。

      また、平日は夜しかVBAの時間が取れないので、進みが遅いですが、宜しくお願いします。




    [191518] Re[10]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ サンダー -(2020/02/25(22:35))
    □U R L/
      では これを読んで確認して下さい。
      
      Sub tes()
      
      Dim Lmax As Long
      Dim Trow As Long
      Dim Tcol As Long
      
      Set wsP = Sheets(1)
      Set wsL = Sheets(2)
      
            LmaxRow = wsL.Range("B65536").End(xlUp).Row     'リストシートのB列の最終行を取得
          i = 1
          j = 1
          k = 6
          m = 1
      
          Do While i <= k         '   i が k になるまで繰り返す
              wsP.Cells(m, j).Value = wsL.Cells(i, 2).Value       '  1回目は 印刷用シートA1セルにリストシートB1セルを転記、2回目は印刷用シートA2セルにリストシートB2セルを転記を6回繰り返す
              i = i + 1
              m = m + 1
          Loop
          
          m = 1
          j = j + 1
          k = k + 6 '改行位置を一つ進める、12にする
          
          Do While i <= LmaxRow           '   リストシートの最終列まで繰り返す
              Do While i <= k '改行位置になるまで繰り返す。
                  wsP.Cells(m, j).Value = wsL.Cells(i, 2).Value   '上記転記を繰り返す
                  i = i + 1
                  m = m + 1
              Loop
              m = 1
              j = j + 1
              k = k + 6  '改行位置を一つ進める、18,24、、、
          Loop
          Debug.Print Time & " - 印刷シート内での転記終了"
        '----------印刷用シートの各セルを転記---------------------------------------
      
          Debug.Print Time & " - 印刷シート内での転記開始"
              wsP.Activate
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   印刷用シートに転記した1行目の最終列を取得
              wsP.Range(wsP.Cells(7, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Value      '印刷用シートの1~6行の最終列までの値を、印刷用シートA7セルに転記
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Clear              '   印刷用シートの1~6行の最終列までの値をクリア
         
              
              j = wsP.Range("XFD7").End(xlToLeft).Column          '7行目の最終列を取得
              '一列目の転記
                  i = 1
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                      wsP.Range(wsP.Cells(1, maxCol), wsP.Cells(6, maxCol)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value    '   7行目以降のA列のデータを1行目に転記、7行目以降のB列のデータを1列おきに転記していく
                      'maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得     転記を繰り返す処理なのでループごとに最終列が変化するから
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value    '転記したデータを2列右側へ値を転記
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column
              '二列目以降の転記
                  For i = 2 To j
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value  '   7行目以降のA列のデータを1行目に転記、7行目以降のB列のデータを1列おきに転記していく
                      maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得     転記を繰り返す処理なのでループごとに最終列が変化するから
                      wsP.Range(wsP.Cells(1, maxCol + 2), wsP.Cells(6, maxCol + 2)).Value = wsP.Range(wsP.Cells(7, i), wsP.Cells(12, i)).Value    '転記したデータを2列右側へ値を転記
                  Next
                  
                  maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
                  
                  
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   1行目の最終列を取得
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 3), wsP.Cells(12, maxCol)).Value
              wsP.Range(wsP.Cells(1, maxCol - 3), wsP.Cells(12, maxCol)).Clear
              
                  For n = 28 To maxCol Step 27                                                '   レイアウト設定のうえで、不必要な空白列を最終列まで削除
                      wsP.Cells(1, n).EntireColumn.Delete
                  Next
              wsP.Rows("7:12").Clear
          Exit Sub
          
          '----------印刷用シートの各セルを転記---------------------------------------
         
          Debug.Print Time & " - 印刷シート内での転記開始"
        'この時点でwsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Clearにデーターがある。
        'ここから最終展開後の最終列は
        maxCol = wsP.Range("XFD1").End(xlToLeft).Column * 4 '4倍
        
              wsP.Activate
              maxCol = wsP.Range("XFD1").End(xlToLeft).Column         '   印刷用シートに転記した1行目の最終列を取得
              wsP.Range(wsP.Cells(7, 1), wsP.Cells(12, maxCol)).Value = wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Value      '印刷用シートの1~6行の最終列までの値を、印刷用シートA7セルに転記
              wsP.Range(wsP.Cells(1, 1), wsP.Cells(6, maxCol)).Clear              '   印刷用シートの1~6行の最終列までの値をクリア
              
              
              j = wsP.Range("XFD7").End(xlToLeft).Column          '7行目の最終列を取得
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191523] Re[11]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/02/26(11:17))
    □U R L/
      こちらから質問した形になっていたらいけないので、簡単にコメントします。
      
      >1、リストシートのB1〜B6セルを印刷用シートのA1セルとC1セルに転記
      >2、リストシートのB7〜B12セルを印刷用シートのE1セルとG1セルに転記
      >3、上記を7回繰り返す
      >4、1〜3をデータ数だけ繰り返す
      結構かと思います。
      
      27列目と28列目は空白列なく連続するところがイレギュラーです。
      まっつわんさんのように、7回ごとに、1列だけ元に戻してもいいですし、
      28列目を予め非表示にしておく方法で逃げると、規則的な処理になるかもしれません。
      (もちろん印刷シートの調整のほうがよほど神経使うということなら
        現行どおりでもよいでしょうけど。)
      
      急ぐことはないので、じっくり取り組まれたらよいと思います。
      




    [191524] Re[11]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ リスキーダック -(2020/02/26(11:19))
    □U R L/
      つまらない事だけど
      
      >Do While i <= k         '   i が k になるまで繰り返す
      
      注釈だと until では・・・・。
      ○○である内はより、までと表現した方が解りやすいので、
      While は、1度も使った事が無い。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191535] Re[12]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/26(22:43))
    □U R L/

      こんばんは。
      ようやくPCの前に座れました。
      仕事中には、中々VBAをする時間がありません。
      移動中などに考えてはいるのですが、どの変数をどのように変化させて、基準となる変数を
      どこに持っていけばよいのか。
      時間は掛かりますが、試行錯誤してみます。


      サンダーさん
      ご提示頂いたコードを読んでみます。が、中々理解が進みません。

      γさん
      イレギュラー対応の前に、変数と変数で頭の中がぐーるぐるです。
      色々なパターンで試してみます。

      リスキーダックさん
      ' i が k になるまで繰り返す
      ではなく、
      iがkになる前まで繰り返す
      でしょうか?
      untilとの違いも調べてみます。




    [191536] Re[13]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ リスキーダック -(2020/02/27(03:06))
    □U R L/
      Do While i <= k である内は。
      
      iがk以下である内は繰り返す。
      iがk以下であるなら繰り返す。
      
      あ、あれ?
      良く考えたら、kまでで良かったですね。
      
      until i= k
      
      iがkと同じにまでの方がしっくりしてたんで・・・。
      すみません。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191537] Re[14]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/02/27(05:30))
    □U R L/
      (1)
      >イレギュラー対応の前に、変数と変数で頭の中がぐーるぐるです。
      
      あなたは変数でものごとを考えるのですか?すごいですね。
      
      >1、リストシートのB1〜B6セルを印刷用シートのA1セルとC1セルに転記
      >2、リストシートのB7〜B12セルを印刷用シートのE1セルとG1セルに転記
      >3、上記を7回繰り返す
      >4、1〜3をデータ数だけ繰り返す
      
      でいいじゃないですか、この中に変数などどこにもでてきませんよね。
      
      (2)
      私がイレギュラーといったのは、こういうことです。伝わっていないようなので。
      変数云々の話ではなく、それ以前の話ですよ?
      
      上の操作は、すべて、A,C,E,G・・・と1列おきにコピーしていきますよね。
      7回繰り返して、8回目の時には、1列とばさずに続けて列に書くんですよね。
      > AA列の次の空白列、つまり28列を削除してそれを最終列まで27列ごとに繰り返しています。
      のところです。(印刷シートのレイアウト上の制約だとのことでした。)
      
      そして、その後はまた1列おきに貼付るんですよね。
      もしそれがなければ、7回繰り返すのではなく、
      すべて同じように1列おきに書き込めばいいだけですよね、という話です。
      
      (3)
      なにをどうするかと言う段階では、変数なんかでは物事は考えませんし、
      それが固まったあとのコーディングの時にはじめて
      変数というものがでてくるんじゃないですか?
      
      それまでは、むしろ広告チラシの裏にでも図を書いて考えたほうが適切かと思います。
      そのほうが直感的ですし、自然なはずです。
      ここをここにコピペする、と矢印を引いたりすればいいだけです。
      
      (4)
      コーディングにあたっての留意点ポイントは、
      6行1列のかたまりを纏めて操作することです。
      
      ・転記元の範囲は、
        最初の範囲を Offsetで次々にずらしていくか、
        Cells(j,"B").Resize(6,1) のようにして、jを変動させていくかです。
      ・転記先の最上セルの指定も同じで、
        Offsetでずらしていくか、セル位置を直接指定するかです。
        その時に、2個ずらすのが基本で、例外的に1個だけずらすときが出てくるという話になります。
      
      このあたり、まっつわんさんの書かれたコードを理解されるとよいです。
      もうそれで問題は解決しているはずなんです。
      リストシートのデータの形態は少し変わってますけど、考え方はそれで尽きています。
      




    [191541] Re[15]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/27(21:09))
    □U R L/

      こんばんは。

      γさん

      ありがとうございます。
      変数を使わないと動作しないと思い、どの値を変数にしてどう変化させるか?
      と、そればかりを考えていました。
      まずは、最初の転記元をA列に転記して、それを繰り返すコードを書いてみます。
      そのうえで、考えてみて、わからなければ、教えて頂いたコードを読み解いてみます。




    [191542] Re[16]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/02/27(21:43))
    □U R L/

      γさんの列の非表示案がいいんじゃないんですか?

      そしたら単純に1列おきで考えられるし、、、、

      セルの位置をインデックス番号で考えると、
      ホントあたまぐちゃぐちゃになりますよね。
      なので、
      手動でやるときの操作をそのままコードにしたらいいんじゃないですか?
      マクロの記録でマクロが9割がた出来そうだし。

      A列はA列とC列にコピペ
      B列はE列とG列にコピペ
      C列はI列とK列に。。。
      (位置あってますっけ?)
      コードがループを使ってなくても、多少スマートでなくても、
      使う人はコードなんて関係ないですよ?

      あと、空白は空白でコピペしちゃってもどうってことないですし。
      (値貼り付けにしとかんと書式は崩れますが)

      コピペしたところで結果が変わって無ければ多少無駄なことをしていたところで、
      ばれないでしょう。
      あとで誰かに見られたところで、
      読んでやっていることが分かるならOK。
      一番困るのが後で読んで意味解んないとき。
      自分で書いても半年後の自分は他人といっしょなので、
      修正の必要が出てきたとき、
      読んで解んなかったら最初から作り直しになるのが一番困ります。
      なんかすごい複雑な計算でセルの位置を出されてたりすると、
      読む気すらなくなりますよ?

      最終的には、
      手動でやってる複雑で長い手順を、
      自動で間違いなくやってもらえるようにしたいだけでしょ?
      セルの位置はもうどこがどこに対応しているか分かるのですから、
      決め打ちでいいと思います。
      (出来ればセル1個づつじゃなく、まとめた範囲で)




    [191543] Re[17]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/02/27(22:18))
    □U R L/

      まっつわんさん

      ありがとうございます。
      ぶっちゃけて言うと、使う人は自分ではなく、同僚に相談されて作ったものです。
      その同僚は、最初に作ったコードで満足しています。
      転記しまくって、自分のPCだと26秒掛かったコードですが、会社PCでは10数秒で動作しています。

      ですが、無駄は省きたいのと、自分の力をアップさせたいので、考えてみます。
      最終的には教えて頂いたコードを実行させるのかもしれませんが。
      やりたい結果は一つでも、そこに至る過程やコードは数多くあると思うので、教わったことを
      少しでも吸収できればと。

      まだ、6行単位を転記させるところで試行錯誤していますが。
      列の非表示案も試してみます。




    [191548] Re[18]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/02/29(11:08))
    □U R L/
      >転記しまくって、自分のPCだと26秒掛かったコードですが、
      >会社PCでは10数秒で動作しています。
      
      個々の各セルを読み書きして転記しまくっているので、数十秒もかかっています。
      列毎にコピペを繰り返せば、
      1秒以内で終わりませんか?
      
      Sub test()
          Dim rngList As Range
          Dim rngCopyTo As Range
          Dim c As Range
          Dim t
          
          t = Timer
          
          Set rngList = Worksheets("リスト").Range("A7").CurrentRegion
          Set rngCopyTo = Worksheets("印刷").Range("A1")
          rngCopyTo.Worksheet.UsedRange.ClearContents
          
          For Each c In rngList.Columns
              c.Copy Union(rngCopyTo, rngCopyTo.Offset(, 2))
              Set rngCopyTo = rngCopyTo.Columns(5)
          Next
          
          MsgBox Timer - t & "秒"
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191549] Re[19]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/02/29(11:18))
    □U R L/
      Sub test()
          Dim rngList As Range
          Dim rngCopyTo As Range
          Dim c As Range
          Dim t
          
          t = Timer
          
          Set rngList = Worksheets("リスト").Range("A7").CurrentRegion
          Set rngCopyTo = Worksheets("印刷").Range("A1")
          rngCopyTo.Worksheet.UsedRange.ClearContents
          
          For Each c In rngList.Columns
              c.Copy
              Union(rngCopyTo, rngCopyTo.Offset(, 2)).PasteSpecial xlPasteValues
              Set rngCopyTo = rngCopyTo.Columns(5)
          Next
          
          MsgBox Timer - t & "秒"
      End Sub
      
      値貼り付けだと少し遅くなりますね。
      画面の更新を止めた方がいいのかな。。。。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191552] Re[20]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/03/01(15:55))
    □U R L/
      こんにちは。
      昨日は休日出勤でさらに深夜まで仕事でした。
      コードも色々考えてみましたが、うまくいきませんでした。
      教えて頂いたコードを実行させて読み解いてみます。
      
      
      サンダーさん
      教えて頂いたコードを実行してみました。
      Mod演算子とInt関数を使って、6行目までを繰り返すのですね。
      こういう変数の考え方もあるんだと勉強になりました。
      
      
      まっつわんさん
      セルを一つずつより、まとめて転記したほうが早いという事ですね。
      前に教えて頂いたコードを動作させようと思い、修正と意味を調べています。
      下記は、まだ途中でちゃんと動作していませんが。
      
      Sub test()
          Dim rngFrom As Range    '元データセル範囲
          Dim rngTo As Range      '転記先セル範囲(印刷用)
          Dim ixFrom As Long      '元データ列番号
          Dim ixTo As Long        '転記先列番号
          Dim i As Long           '列番調整用
          
          With Worksheets("リスト")
              Set rngFrom = Application.Range(.Range("B1"), .Cells(7, .Columns.Count).End(xlToLeft))
          End With
          Set rngTo = Worksheets("印刷用").Range("A1:A6")
          
          ixTo = 1
          For ixFrom = 1 To rngFrom.Rows.Count Step 2
              rngTo.Columns(ixTo).Value = rngFrom.Columns(ixFrom).Value
              rngTo.Columns(ixTo + 2).Value = rngFrom.Columns(ixFrom + 1).Value
              
              ixTo = ixTo + 4
              i = i + 1
              If i > 6 Then
                  ixTo = ixTo - 1
                  i = 0
              End If
          Next
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191557] Re[21]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/02(14:09))
    □U R L/
      >1、リストシートのB1〜B6セルを印刷用シートのA1セルとC1セルに転記
      >2、リストシートのB7〜B12セルを印刷用シートのE1セルとG1セルに転記
      >3、上記を7回繰り返す
      >4、1〜3をデータ数だけ繰り返す
      
      >問題は、AA列とAB列の間には空白行が無いので
      
      以下でどうですか?
      
      Sub test()
          Dim wsP     As Worksheet
          Dim wsL     As Worksheet
          Dim maxRow  As Long
          Dim kaisu   As Long
          Dim k       As Long
          Dim r       As Long
          Dim j       As Long
          Dim rng     As Range
      
          Set wsL = Worksheets("リスト")
          Set wsP = Worksheets("印刷用")
      
          maxRow = wsL.Cells(wsL.Rows.count, "B").End(xlUp).Row
          kaisu = maxRow / 6
          
          j = 1   '転記先の列
          For k = 1 To kaisu
              '転記
              r = (k - 1) * 6 + 1      '転記元の開始行
              Set rng = wsL.Cells(r, "B").Resize(6, 1)  ' 6個分まとめて操作
              wsP.Cells(1, j).Resize(6, 1).Value = rng.Value
              wsP.Cells(1, j + 2).Resize(6, 1).Value = rng.Value
                      
              '次の書き込み位置の調整
              j = j + 4
              '7回ごとに、書き込み位置を調整
              If (k - 1) Mod 7 = 6 Then j = j - 1
          Next
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191562] Re[22]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/03/03(20:11))
    □U R L/

      こんばんは。

      γさん
      ありがとうございます。
      教えて頂いたコードで動作しました。
      Resizeの使い方やロジックを読み解いてみます。

      最近時間がとれなくて、進みが遅いですが、少しずつ確認していきます。




    [191585] Re[23]: ループ処理の考え方について-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/03/07(16:56))
    □U R L/
      こんにちは。
      色々教えて頂いたコードを実行させてみて、既存のコードを組み合わせて、
      思い通りの動作ができました。
      教えて頂いた皆様、ありがとうございました。
      
      
      その中で、理解できない点もあります。
      
       まっつわんさんに教えて頂いたコードの
      
      With Worksheets("リスト")
         Set rngFrom = Application.Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
      End With
      
      Application.Range がわかりません。
      A12セルから最終列7行目までの範囲をrngFromという変数に代入するという意味だと
      思うのですが、Application と入れる事の意味や理由がわかりません。
      Set rngFrom = .Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
      でも動作しました。
      
      最終的には、γさんのコードで転記を繰り返してその後行の調整、書式設定する、別のプロシージャで列の調整を行うようにしました。
      転記で2秒、列調整で26秒でした。
      分けることで、列の調整はリスト数の変動が大きくなければそんなに実行しないので時間の掛かる処理の
      回数が増えない。
      転記のみが2秒なので、セル内改行などの微調整をした際にも処理時間が短くて済む。
      という結果になりました。
      
      やりたい事を変数にして繰り返し処理する為に、
      6で割った整数を取得したり余りを取得して、その変数にさらに乗算して記述するというのが
      思いつきもしませんでした。
      これからも色々やってみて、頑張ってみます。
      
      
      
      Sub リストから転記()
          Dim wsP As Worksheet, wsL As Worksheet, maxrow As Long, kaisu As Long, k As Long, r As Long, j As Long
          Dim rng As Range, Pmaxrow As Long
      
           Application.ScreenUpdating = False
          
          Debug.Print Time & " - 転記開始"
          
          Set wsL = Worksheets("リスト")
          Set wsP = Worksheets("印刷用")
          maxrow = wsL.Cells(wsL.Rows.Count, "B").End(xlUp).Row
          kaisu = maxrow / 6
          j = 1   '転記先の列
              For k = 1 To kaisu
                  '転記
                  r = (k - 1) * 6 + 1      '転記元の開始行
                  Set rng = wsL.Cells(r, "B").Resize(6, 1)  ' 6個分まとめて操作
                  wsP.Cells(1, j).Resize(6, 1).Value = rng.Value
                  wsP.Cells(1, j + 2).Resize(6, 1).Value = rng.Value
                      
               '  次の書き込み位置の調整
               j = j + 4
                  '7回ごとに、書き込み位置を調整
               If (k - 1) Mod 7 = 6 Then j = j - 1
           Next
          
          Debug.Print Time & " - 転記終了"
          
          '----------行挿入と行の高さ調整---------------------------------------------
          Debug.Print Time & " - 行調整開始"
      
          Pmaxrow = wsP.Range("C1").End(xlDown).Row           '   最終行を取得
          wsP.Rows(1 & ":" & Pmaxrow).EntireRow.RowHeight = 63.75        '   1行目から最終行までのの高さを63.75に変更
      
              For n = Pmaxrow To 2 Step -1
                  wsP.Cells(n, "A").EntireRow.Insert          '   最終行から2行目まで、1行おきに行挿入
                  wsP.Cells(n, "A").EntireRow.RowHeight = 39.75   '   挿入した行の高さを39.75に変更
              Next
      
          Debug.Print Time & " - 行調整終了"
      '---------------------------------------------------------------------------
      
          
      '----------セルの書式設定---------------------------------------------
          Debug.Print Time & " - セルの書式設定"
          
          i = wsL.Range("D4").Value \ 42      'リストシートのD4セルのリスト数から処理列数を変数iに代入
          i = i * 30
              wsP.Rows("1:11").Orientation = xlVertical      '   セルの書式設定 縦書き
               wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, i)).ShrinkToFit = True        '    セルの書式設定 縮小して表示
              wsP.Rows("1:11").Font.Size = 9      '   フォントサイズ変更
              
              
          Debug.Print Time & " - 終了"
      '---------------------------------------------------------------------------
      
      
          wsP.Activate
          wsP.Range("A1").Select
          ThisWorkbook.Save
          
          Application.ScreenUpdating = True
          
      End Sub
      
      
      Sub 行初期設定()
      
          Dim wsP As Worksheet, i As Long, wsL As Worksheet, Pmaxrow As Long, n As Long
          
          Application.ScreenUpdating = False      '画面更新を停止
          
          Debug.Print Time & " - スタート"
          
          Set wsL = Worksheets("リスト")
          Set wsP = Worksheets("印刷用")
          
          
      '----------列の幅調整---------------------------------------------
          Debug.Print Time & " - 列幅開始"
          
          i = wsL.Range("D4").Value \ 42      'リストシートのD4セルのリスト数から処理列数を変数iに代入
          i = i * 30
          
              For n = 1 To i Step 2
                  wsP.Cells(1, n).EntireColumn.ColumnWidth = 4.38         '   1行目から最終列まで、2列おきに列幅を変更
              Next
              
              For n = 2 To i Step 4
                  wsP.Cells(1, n).EntireColumn.ColumnWidth = 1.38         '   2列目から最終列まで、4列おきに列幅を変更
              Next
              
              For n = 4 To i Step 4
                  wsP.Cells(1, n).EntireColumn.ColumnWidth = 7.88         '   4列目から最終列まで、4列おきに列幅を変更
              Next
              
              
              For n = 28 To i Step 27                                                '   レイアウト設定のうえで、不必要な空白列を最終列まで削除
                  wsP.Cells(1, n).EntireColumn.Delete
              Next
          
          Debug.Print Time & " - 列幅終了"
      '---------------------------------------------------------------------------
          
      '----------セルの書式設定---------------------------------------------
          Debug.Print Time & " - セルの書式設定"
          
          i = wsL.Range("D4").Value \ 42      'リストシートのD4セルのリスト数から処理列数を変数iに代入
          i = i * 30
              wsP.Rows("1:11").Orientation = xlVertical      '   セルの書式設定 縦書き
               wsP.Range(wsP.Cells(1, 1), wsP.Cells(12, i)).ShrinkToFit = True        '    セルの書式設定 縮小して表示
              wsP.Rows("1:11").Font.Size = 9      '   フォントサイズ変更
              
              
          Debug.Print Time & " - 終了"
      '---------------------------------------------------------------------------
      
          ThisWorkbook.Save
          
          Application.ScreenUpdating = True       '   画面更新を再開
             
      End Sub
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191589] Re[24]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/09(10:24))
    □U R L/
      完成されたようで何よりです。以下、参考レベルです。
      
      今更ですが、
      データの転記とは、以下の内容と聞いていましたが、
      そのあとに「行の挿入」をしていて驚きました。
      全然そういう仕様ではなかったのですね。残念です。
      
      >1、リストシートのB1〜B6セルを印刷用シートのA1セルとC1セルに転記
      >2、リストシートのB7〜B12セルを印刷用シートのE1セルとG1セルに転記
      >3、上記を7回繰り返す
      >4、1〜3をデータ数だけ繰り返す
      
      こういうケースでは、
      ・予め書式を揃えたテンプレートを作っておき、
      ・データだけを書き込むと言う方法が一般的だと思います。
      
      参考までに、上記の方針でコードを作成してみました。
      
      '===================================================
      ' リストシートから印刷シートにデータを転記する。(値のみ設定)
      
      Sub データ転記()
          Dim wsP As Worksheet
          Dim wsL As Worksheet
          Dim maxrow As Long
          Dim group As Long, startColumn As Long
          Dim i As Long, j As Long, k As Long, r As Long
          
          Set wsL = Worksheets("リスト")
          Set wsP = Worksheets("印刷用")
          
          maxrow = wsL.Cells(Rows.count, "B").End(xlUp).Row          
          group = WorksheetFunction.Ceiling((maxrow - 1), 42) \ 42   
      
          For i = 1 To group          '6*7個の数値ごとの繰り返し
              startColumn = (i - 1) * 27 + 1  '転記先の28列目は空白列無く詰めるため
              For j = 1 To 7          '転記先列の繰り返し
                  For k = 1 To 6      '6個の数値の繰り返し
                      r = (i - 1) * 42 + (j - 1) * 6 + k
                      wsP.Cells((k - 1) * 2 + 1, startColumn + (j - 1) * 4).Value = wsL.Cells(r, 2).Value
                      wsP.Cells((k - 1) * 2 + 1, startColumn + (j - 1) * 4 + 2).Value = wsL.Cells(r, 2).Value
                  Next
              Next
          Next
      
      End Sub
      
      '===================================================
      ' 書式等を一度だけ実行すれば良いのでは?
      ' 余裕を見て20ページ分までを作成するものとした。
      ' 対象範囲は、@1〜11行 A1列から27列×20=540列まで。
      
      Sub template作成()
      
          Const maxPage As Long = 20  ' 最大20ページ(適宜修正)
          Dim wsP As Worksheet
          Dim k As Long
          Dim maxCol As Long
          
          Application.ScreenUpdating = False  
      
          Set wsP = Worksheets("印刷用")
      
          '-------- 列幅の調整--------------------------
          maxCol = 28 * maxPage
      
          For k = 1 To maxCol Step 2
              wsP.Columns(k).ColumnWidth = 4.38
          Next
      
          For k = 2 To maxCol Step 4
              wsP.Columns(k).ColumnWidth = 1.38
          Next
      
          For k = 4 To maxCol Step 4
              wsP.Columns(k).ColumnWidth = 7.88
          Next
      
          For k = 28 To maxCol Step 27 'ここを列幅0とすることで、全体を簡素化できる可能性あり
              wsP.Columns(k).Delete
          Next
          
          '------- 行高の調整 --------------------------
          For k = 1 To 9 Step 2
              wsP.Rows(k).RowHeight = 63.75
              wsP.Rows(k + 1).RowHeight = 39.75
          Next
          wsP.Rows(11).RowHeight = 63.75
          
          '--------セルの書式設定-----------------------
          wsP.Rows("1:11").Orientation = xlVertical             '縦書き
          wsP.Cells(1, 1).Resize(12, maxCol).ShrinkToFit = True '縮小して表示
          wsP.Rows("1:11").Font.Size = 9                        'フォントサイズ変更
      
          ThisWorkbook.Save
          Application.ScreenUpdating = True       '   画面更新を再開
      End Sub
      
      列の設定に26秒って、異常に時間掛かりますね。ちょっと理解しにくい。
      
      また、一つ気になるのは、印刷範囲の指定などの話は全然出てきていないが、
      組み込む必要があるのでは?と思いました。
      まあ、それは印刷実行プロシージャで別途対応しているんでしょうか。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191590] Re[25]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/03/09(21:18))
    □U R L/

      γ さん

      ありがとうございます。
      列の調整も行の調整も両方あって、レイアウトしなくてはいけなかったので、
      行の挿入や高さ調整は何とか記述できてしまったのです。
      本来は、完成形のレイアウトを目指して転記するべきだと思うのですが。

      教えて頂いたコード、後程実行してみます。
      列の設定ですが、自宅PCだと26秒で、会社の同僚のPCだと10数秒らしいです。
      明日正確な時間を聞いてみますが、自宅PCの処理速度がそこまで遅いとも思いません。
      エクセルのバージョンによるのか、他の要因があるのかはわかりませんが。

      印刷範囲の設定ですが、シートのページ設定はしてある状態で、行列の調整をしています。
      改ページビューで見ると、ちょうどページ内に収まっています。

      明日から出張なので、遅くなりますが、確認してみます。




    [191592] Re[26]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/10(19:52))
    □U R L/
      >行の挿入や高さ調整は何とか記述できてしまったのです。
      それは結構ですよ、否定してなんかいません。
      ただ、機能が混在していますね、というだけです。
      まあ、それも五十歩百歩です。余り厳密に考える必要もないのかもしれません。
      私だったらそうはしませんが、人それぞれです。
      むしろ、ご自分で作成されたことのほうに価値があるのでしょう。
      
      26秒というのもこちらの感覚を申し上げただけで(私のところでは2,3秒なので)
      どれだけかかろうが正直こちらはどうということはありません。
      時間がかかる環境もあるのでしょう。
      追加の検証して頂く必要もありません。
      
      >明日から出張なので、遅くなりますが、確認してみます。
      こちらには気遣い不要です。
      私は特にこれ以上申し上げることもありませんので。
      




    [191594] Re[27]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ まっつわん -(2020/03/11(17:45))
    □U R L/
       まっつわんさんに教えて頂いたコードの
      
      >With Worksheets("リスト")
      >   Set rngFrom = Application.Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
      >End With
      
      >Application.Range がわかりません。
      >A12セルから最終列7行目までの範囲をrngFromという変数に代入するという意味だと
      >思うのですが、Application と入れる事の意味や理由がわかりません。
      >Set rngFrom = .Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
      >でも動作しました。
      
      Excel 開発者用リファレンス 
      Application.Range プロパティ 
      セルまたはセル範囲を表す Range オブジェクトを返します。
      構文
      
      式.Range(Cell1, Cell2)
      
      式   Application オブジェクトを表す変数。
      
      んとですね、
      単に
      Range("A2")といっても、
      そのオブジェクトにはどのシートのA2セルなのか、
      あるいはどのブックなのかという情報を持っているわけです。
      なので、
      Rangeプロパティの引数にRangeオブジェクトを指定した場合は、
      括弧の中でシートを指定しているのに、
      Worksheets(1).Range(Wroksheets(1).Range("A12"),Wroksheets(1).range("C5"))
      のように、
      その外でも指定するのは饒舌ではないか?というのが僕の考えです。
      
      また、たまに、
      Worksheets(2).Range(Wroksheets(1).Range("A12"),Wroksheets(1).range("C5"))
      頭の親オブジェクトと括弧の中のオブジェクトに矛盾がある記述をしてしまう場合があります。
      これらのちょっとした勘違いでもエラーで止まるので、書き間違い間違い防止の
      意味でも同じことをあちこちに書かないようにしてます。
      
      Set rngFrom = .Range(.Range("A12"), .Cells(7, .Columns.Count).End(xlToLeft))
      With句を使えば間違えようがないのでそれでもいいと思います。
      
      そもそも、Application.Rangeって僕くらいしか書いてないかもです。
      あとは、ご自分の考えでルールを決めて行かれればよいと思います。
      
      今回の件、僕ならマクロを使わず、
      手動で書式設定して、
      数式で値を参照しちゃうかなぁ。。。。(コピーしてリンク貼り付けで)
      インデックス番号の操作とか考え出したら訳わからんくなるんで、
      視覚的に解った方がストレスがないかな。
      1回作ったら終わりだし。。。
      形が崩れないようにシートの保護をしておけば、
      大丈夫ですよね?
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191595] Re[28]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ BB -(2020/03/12(18:52))
    □U R L/

      どうせなら、
      Excel.Application.Range("A1").Value
      って書けばいいのに・・・。




    [191596] Re[29]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/13(01:09))
    □U R L/
      ついでながら余談を。
      
      下記の(1)は定番中の定番の頻出質問です。なぜエラーになるんでしょう。
      それは、中のRangeオブジェクトにシート指定がないので、アクティブシートが
      指定されたことになり、Sheet1が冒頭のSheet2指定と矛盾するので NG。
      だから,下記の (2)のように書きましょう、というのが定番回答。
      ここまではOKです。
      
      まっつわんさんの方式は、(3)です。
      
      それでは、(4)はどうなると思いますか?
      (1)と同じ理屈でエラーになるんでしょうか?
      自信持って回答できます?
      
      Sub main()
          Dim ws1 As Worksheet, ws2 As Worksheet
          Set ws1 = Sheet1
          Set ws2 = Sheet2
          ws1.Activate
          
          Debug.Print ws2.Range(Range("A1"), Range("B2")).Address                '(1)
          Debug.Print ws2.Range(ws2.Range("A1"), ws2.Range("B2")).Address         '(2)
          Debug.Print Application.Range(ws2.Range("A1"), ws2.Range("B2")).Address '(3)
          Debug.Print Range(ws2.Range("A1"), ws2.Range("B2")).Address             '(4)
      End Sub
      
      実は、(3)と同様に正常に動作します。
      
      (3)や(4)を余り見ないのは、
      複数のシートを同時に扱う場合は、
      Rangeの頭にはシートをつけるべし、
      というスタイルが普及していて、
      コーディングスタイルとしても、こうしておくと紛れが無い、
      ということなんでしょうか。
      
      余談でした。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191598] Re[30]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/13(19:21))
    □U R L/

      >Application.Range

      わたしは、シートモジュールでしか使ったことないです。たぶん。





    [191599] Re[31]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/13(21:38))
    □U R L/
      なるほど。
      私の話((4)が(3)と同じ動作をする)は、
      "標準モジュールに書いたとき"という限定が必要というご指摘ですね。
      その前提でいたのですが、誤解を招きますね。
      ありがとうございます。




    [191600] Re[32]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/13(23:59))
    □U R L/
      あっ、そのようなつもりはなくて、
      というか、むつしいことは、苦手なので、指摘などできません。
      
      γさんの例でいうと、
      わたしは、自信がないので、(2)の書き方しかしないのですが、
      
      こんなときに、(4)の書き方をしていました。
      
      adr="Sheet2!$A$1:$A$10"
      Set rng=Range(adr)
      
      最初、(4)の書き方だということに気が付かないまま、使っていました。
      なので、Application.Rangeを使ったことがなかったのですが
      
      同じことをシートモジュールでしようとして、エラーになって、
      はじめて、シート指定していないことに気が付き
      標準モジュールでは(4)の書き方でもエラーにならないことを知りました。
      
      同時に、(3)の書き方を覚えました。
      
      そういうわけで、シートモジュールでしか、Application.Rangeを使ったことがないです。
      ごめんなさい。他の人には、どうでもよい話でした。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191605] Re[33]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/14(10:47))
    □U R L/
      コメントいただき、ありがとうございました。
      
      話はぶっ飛びますが、
      将棋の格言のひとつに、
      「敵の打ちたいところに打て」
      というのがあります。
      敵にここに打たれたら致命的だな、と言うとき、
      そこに予め自分の駒を置くことを言います。
      
      Range(ws2.Range("A1"), ws2.Range("B2"))             '(4)  
      じゃなくて、
      Application.Range(ws2.Range("A1"), ws2.Range("B2")) '(3)
      とするのは、上の格言と何か似ていませんか?
      似ていなかったら失礼。(落ちにならないみたいだな)
      




    [191619] Re[34]: ループ処理の考え方について-

    記事引用/メール受信=OFF■

    □投稿者/ PopCultVenus -(2020/03/14(19:57))
    □U R L/

      こんばんは。

      まっつわんさん
      Rangeオブジェクトを記述するときは、都度シート名を指定しないといけないのですね。
      自分は、親オブジェクトには指定しもて括弧の中は指定しない時がありました。
      勉強になりました。
      また、そもそもVBAでなくてもというご指摘ですが、もっともかと思います。
      言われてみればその通りですね。セルごとに=で繋げれば、最初の手間だけで済みました。
      それも含めて皆様がから教えて頂いたので良かったと思います。

      BBさん
      Rangeオブジェクトの上がApplicationで、その上はexcelということなのですね。

      γさん
      わかりやすい説明、ありがとうございました。
      複数のシートを操作していると、エラーになったりしてました。そういう時は、操作するシートを
      ws1.Activate
      などのようにしてあげるとエラーが出なくなったので、アクティブにしたり、セレクトしたりしてました。
      本来、操作するシートを指定してあげれば、問題ないという事なのですね。
      記述を考える時に、今は目の前のことを解決するように考えて記述していますが、
      完成形をイメージして、機能ごとに記述するように頑張ってみます。

      マナさん
      シートモジュールと標準モジュールの違いがわかっていませんが、違うのですね。
      もっと勉強します。








このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G