[[20230126164916]] 『卒業者台帳を作成したいです。』(るっく) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『卒業者台帳を作成したいです。』(るっく)

「生徒情報シート」から情報を取得して、「授与台帳シート」に貼り付けたいです。
その際、下の図のように、10名を左側(A6セル〜)に貼り付け、次の10名を右側(G6セル〜)に貼り付け、その次の10名を左側(A16セル〜)に貼り付け、というように、左右を互い違いに貼り付けることはできますか?
自分でコードを書こうとしたのですが、頭がパンクしてわけがわからなくなりました。

     |[A]     |[B]           |[C]         |[D]               |[E]     |[F]|[G]     |[H]           |[I]       |[J]               |[K]     
 [5] |証書番号|卒業年月日    |氏   名  |生年月日          |備  考|   |証書番号|卒業年月日    |氏   名|生年月日          |備  考
 [6] |第1号   |令和5年3月31日|塩谷 小夏  |平成22年12月29日生|        |   |第11号  |令和5年3月31日|黒沢 璃乃|平成22年4月28日生 |        
 [7] |第2号   |令和5年3月31日|森下 依子  |平成22年5月23日生 |        |   |第12号  |令和5年3月31日|竹村 結花|平成22年8月28日生 |        
 [8] |第3号   |令和5年3月31日|南 真琴    |平成22年10月23日生|        |   |第13号  |令和5年3月31日|川田 和裕|平成22年6月16日生 |        
 [9] |第4号   |令和5年3月31日|織田 敏哉  |平成22年5月4日生  |        |   |第14号  |令和5年3月31日|神谷 泰佑|平成22年8月10日生 |        
 [10]|第5号   |令和5年3月31日|長谷部 志帆|平成22年5月6日生  |        |   |第15号  |令和5年3月31日|大河原 樹|平成22年4月17日生 |        
 [11]|第6号   |令和5年3月31日|金野 光子  |平成22年8月12日生 |        |   |第16号  |令和5年3月31日|田代 道雄|平成22年8月27日生 |        
 [12]|第7号   |令和5年3月31日|杉原 武秀  |平成22年10月31日生|        |   |第17号  |令和5年3月31日|風間 有香|平成22年8月2日生  |        
 [13]|第8号   |令和5年3月31日|田口 信次  |平成22年4月3日生  |        |   |第18号  |令和5年3月31日|大谷 文  |平成23年3月31日生 |        
 [14]|第9号   |令和5年3月31日|宮地 雫    |平成22年11月5日生 |        |   |第19号  |令和5年3月31日|松村 香音|平成22年9月13日生 |        
 [15]|第10号  |令和5年3月31日|松木 珠希  |平成23年1月14日生 |        |   |第20号  |令和5年3月31日|南田 拓歩|平成22年6月10日生 |        
 [16]|第21号  |令和5年3月31日|難波 愛奈  |平成22年6月23日生 |        |   |第31号  |令和5年3月31日|杉浦 早苗|平成22年9月13日生 |        
 [17]|第22号  |令和5年3月31日|本山 遥花  |平成22年11月19日生|        |   |第32号  |令和5年3月31日|金丸 圭子|平成22年6月10日生 |        
 [18]|第23号  |令和5年3月31日|市原 孝義  |平成22年12月14日生|        |   |第33号  |令和5年3月31日|栗山 基一|平成22年11月19日生|        
 [19]|第24号  |令和5年3月31日|丸田 弓斗  |平成23年3月12日生 |        |   |第34号  |令和5年3月31日|川田 正三|平成22年12月14日生|        
 [20]|第25号  |令和5年3月31日|小峰 梨々那|平成23年2月15日生 |        |   |第35号  |令和5年3月31日|熊田 裕一|平成22年11月20日生|        
 [21]|第26号  |令和5年3月31日|大内 峻輝  |平成22年8月24日生 |        |   |第36号  |令和5年3月31日|蛭田 朱音|平成22年12月15日生|        
 [22]|第27号  |令和5年3月31日|勝田 孝吉  |平成22年6月18日生 |        |   |第37号  |令和5年3月31日|重田 志歩|平成22年11月21日生|        
 [23]|第28号  |令和5年3月31日|西岡 真希  |平成23年1月9日生  |        |   |第38号  |令和5年3月31日|三枝 直人|平成22年12月16日生|        
 [24]|第29号  |令和5年3月31日|澤田 紫雲  |平成22年6月19日生 |        |   |第39号  |令和5年3月31日|橘 賢次  |平成22年11月22日生|        
 [25]|第30号  |令和5年3月31日|川嶋 風香  |平成23年1月10日生 |        |   |第40号  |令和5年3月31日|山本 信彦|平成22年12月17日生|        

________________________________________________________________

Option Explicit
Sub 授与台帳()

    Dim 年 As Long
    Dim 名前 As String
    Dim 正式名前 As String
    Dim 生年月日 As String
    '変数名は、校務支援ソフトが出力するエクセルファイルに合わせています。
    Dim 証書番号 As Long
    Dim 卒業年 As Variant
    Dim 最高学年 As Long '小学校でも中学校でも使えるように
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim lastrow As Long
    Dim wsS
    Dim wsD
    Dim wsJ
    Set wsS = Worksheets("生徒情報")
    Set wsD = Worksheets("データベース")
    Set wsJ = Worksheets("授与台帳")

  ’「生徒情報」シートの整理

    Call 元データのフィルタ解除と重複削除

   証書番号 = InputBox("証書番号は何番からスタートしますか?" & vbCrLf & "(半角数字で入力)")
    卒業年 = Format(Now, "ggge年")
     '「生徒情報」シートの学年は文字列のため、そこからは直接数値を取得できない。
   ’そのため、わざわざデータベースシートに別途最大学年を入力している。
    最高学年 = wsD.Cells(11, 2).Value
    '内容消去
    wsJ.Range("a5").CurrentRegion.Offset(1, 0).ClearContents
    wsJ.Range("g5").CurrentRegion.Offset(1, 0).ClearContents

============以降、試行錯誤しているうちに、わけわからなくなりました。============

    i = 2
    j = 6
    k = 1
    l = 0
    Do While wsS.Cells(i, 3).Value <> ""
        If wsS.Cells(i, 3).Value <> 最高学年 Then
            i = i + 1
        Else
            年 = wsS.Cells(i, 3).Value
            名前 = wsS.Cells(i, 17).Value
            正式名前 = wsS.Cells(i, 19).Value
            生年月日 = Format(wsS.Cells(i, 22).Value, "ggge年m月d日")

            lastrow = wsS.Cells(Rows.Count, 1).End(xlUp).Row
            For j = 6 To 15
                wsJ.Cells(j, k).Value = "第" & 証書番号 & "号"
                wsJ.Cells(j, k + 1).Value = 卒業年 & vbCrLf & "3月31日"
                wsJ.Cells(j, k + 2).Value = 名前
                If 正式名前 <> " " Then
                    wsJ.Cells(j, k + 2).Value = 正式名前
                End If
                wsJ.Cells(j, k + 3).Value = 生年月日 & "生"
                i = i + 1
                証書番号 = 証書番号 + 1
            Next
            k = 7
            For j = 6 To 15
                wsJ.Cells(j, k).Value = "第" & 証書番号 & "号"
                wsJ.Cells(j, k + 1).Value = 卒業年 & vbCrLf & "3月31日"
                wsJ.Cells(j, k + 2).Value = 名前
                If 正式名前 <> " " Then
                    wsJ.Cells(j, k + 2).Value = 正式名前
                End If
                wsJ.Cells(j, k + 3).Value = 生年月日 & "生"
                i = i + 1
                証書番号 = 証書番号 + 1
            Next
            For j = 2 To lastrow Step 10
                Select Case j
                    Case Is < 100
                        If Left(j, 1) Mod 2 = 0 Then
                            k = 1
                        Else
                            k = 7
                        End If
                    Case Is >= 100
                        If Left(j, 2) Mod 2 = 0 Then
                            k = 1
                        Else
                            k = 7
                        End If
                End Select
                l = wsJ.Cells(Rows.Count, k).End(xlUp).Offset(1, 0).Row
                wsS.Cells(j, 1).Resize(10).Copy wsJ.Cells(l, k)
            Next

            Next

        End If
    Loop
End Sub

< 使用 Excel:unknown、使用 OS:unknown >


入力し忘れました。
Excel2021 & windows11です。
(るっく) 2023/01/26(木) 17:04:18

 生徒情報シートはどうなっているのですか?
 ご提示のコードから推理力を働かせて、逆算せよと言うことなんですか?

 以下の4人分でいいので、元ネタデータが、どのセルにどう入力されているのか示せませんか?

 [6] |第1号   |令和5年3月31日|塩谷 小夏  |平成22年12月29日生|        |   |第11号  |令和5年3月31日|黒沢 璃乃|平成22年4月28日生 |        
 [7] |第2号   |令和5年3月31日|森下 依子  |平成22年5月23日生 |        |   |第12号  |令和5年3月31日|竹村 結花|平成22年8月28日生 |    

(半平太) 2023/01/26(木) 17:20:25


ループ処理を入れ子で作ってしまっているのが失敗の元です。
生徒情報シートから卒業者リストをつくるための処理と
授与台帳シートに書き込む処理を独立させましょう。

分離できなければどちらかをループにさせず、その都度足したり引いたりする処理にしましょう。
(お邪魔します) 2023/01/26(木) 18:15:15


半平太様

ご返信ありがとうございます。
大変失礼しました。
生徒情報シートでは、このように、氏名はQ列に、生年月日はV列に入っています。
第189行よりも上の行には、1年生から5年生までが順に並んでいます。

      |[Q]         	      |[V]       
 [189]|塩谷 小夏  	 [189]|2010/12/29
 [190]|森下 依子  	 [190]|2010/5/23 
 [191]|南 真琴    	 [191]|2010/10/23
 [192]|織田 敏哉  	 [192]|2010/5/4  
 [193]|長谷部 志帆	 [193]|2010/5/6  
 [194]|金野 光子  	 [194]|2010/8/12 
 [195]|杉原 武秀  	 [195]|2010/10/31
 [196]|田口 信次  	 [196]|2010/4/3  
 [197]|宮地 雫    	 [197]|2010/11/5 
 [198]|松木 珠希  	 [198]|2011/1/14 
 [199]|黒沢 璃乃  	 [199]|2010/4/28 
 [200]|竹村 結花  	 [200]|2010/8/28 
 [201]|川田 和裕  	 [201]|2010/6/16 
 [202]|神谷 泰佑  	 [202]|2010/8/10 
 [203]|大河原 樹  	 [203]|2010/4/17 
 [204]|田代 道雄  	 [204]|2010/8/27 
 [205]|風間 有香  	 [205]|2010/8/2  
 [206]|大谷 文    	 [206]|2011/3/31 
 [207]|松村 香音  	 [207]|2010/9/13 
 [208]|南田 拓歩  	 [208]|2010/6/10 
 [209]|難波 愛奈  	 [209]|2010/6/23 
 [210]|本山 遥花  	 [210]|2010/11/19
 [211]|市原 孝義  	 [211]|2010/12/14
 [212]|丸田 弓斗  	 [212]|2011/3/12 
 [213]|小峰 梨々那	 [213]|2011/2/15 
 [214]|大内 峻輝  	 [214]|2010/8/24 
 [215]|勝田 孝吉  	 [215]|2010/6/18 
 [216]|西岡 真希  	 [216]|2011/1/9  

(るっく) 2023/01/26(木) 20:28:41


お邪魔します様

なるほど、確かにループの入れ子は苦手です。
分割するのもアリですね。大きなヒントをありがとうございます。
(るっく) 2023/01/26(木) 20:30:25


學校のセンセイがこの程度なら日本の情報教育はお先真っ暗ですね
(なんだか) 2023/01/26(木) 20:36:14

学校に不審者が出没し始めたら危険この上ないな。
(MK) 2023/01/26(木) 20:44:39

これがダミーデータじゃなくてホントのデータだったら笑う
(FBI) 2023/01/26(木) 21:03:29

るっくさん
これってガチデータっすか?
(CIA) 2023/01/26(木) 21:10:23

あ、この名簿は疑似個人情報ジェネレータで作成したダミーです。
(るっく) 2023/01/26(木) 21:12:04

こんばんわ。^^
色々方法は御座いますでしょうが、一案で
開始行〜最終行までワンループで、10件毎にブレイク処理を設け
配列か連想配列等を一つ、又は、二つ分用意して
フラグ立てで1列目か二列目か判定して書き分ければ
良いだけではないでせうか。
勿論、直接セル書でも。(#^^#)v

(隠居Z) 2023/01/26(木) 21:39:25


 こんなのでいいような気がしますけども

 Sub 授与台帳()
     Dim 年 As Long
     Dim 名前 As String
     Dim 正式名前 As String
     Dim 生年月日 As String
     Dim 証書番号 As Long
     Dim 卒業年 As Variant
     Dim 最高学年 As Long '小学校でも中学校でも使えるように
     Dim i As Long
     Dim j As Long
     Dim wsS
     Dim wsD
     Dim wsJ
     Dim rowToWrite
     Dim colToWrite
     '変数名は、校務支援ソフトが出力するエクセルファイルに合わせています。
     Set wsS = Worksheets("生徒情報")
     Set wsD = Worksheets("データベース")
     Set wsJ = Worksheets("授与台帳")
     '「生徒情報」シートの整理
     '    Call 元データのフィルタ解除と重複削除
     '   証書番号 = InputBox("証書番号は何番からスタートしますか?" & vbCrLf & "(半角数字で入力)")
     証書番号 = 1
     卒業年 = Format(Now, "ggge年")
     '「生徒情報」シートの学年は文字列のため、そこからは直接数値を取得できない。
     'そのため、わざわざデータベースシートに別途最大学年を入力している。

     最高学年 = wsD.Cells(11, 2).Value

     '内容消去
     wsJ.Range("a5").CurrentRegion.Offset(1, 0).ClearContents
     wsJ.Range("g5").CurrentRegion.Offset(1, 0).ClearContents
     '============以降、試行錯誤しているうちに、わけわからなくなりました。============

     i = 2
     j = 1

     Do While wsS.Cells(i, 3).Value <> ""
         If wsS.Cells(i, 3).Value = 最高学年 Then

             年 = wsS.Cells(i, 3).Value
             名前 = wsS.Cells(i, 17).Value
             正式名前 = wsS.Cells(i, 19).Value
             生年月日 = Format(wsS.Cells(i, 22).Value, "ggge年m月d日")

             rowToWrite = Application.Floor((j - 1), 20) / 2 + (j - 1) Mod 10 + 6
             colToWrite = (Int((j - 1) / 10) Mod 2) * 6 + 1

             wsJ.Cells(rowToWrite, colToWrite).Value = "第" & 証書番号 & "号"
             wsJ.Cells(rowToWrite, colToWrite + 1).Value = 卒業年 & vbCrLf & "3月31日"
             wsJ.Cells(rowToWrite, colToWrite + 2).Value = 名前

             If 正式名前 <> " " Or 正式名前 <> "" Or 正式名前 <> " " Then
                 wsJ.Cells(rowToWrite, colToWrite + 2).Value = 正式名前
             End If

             wsJ.Cells(rowToWrite, colToWrite + 3).Value = 生年月日 & "生"
             '
             証書番号 = 証書番号 + 1
             j = j + 1 '枚数

         End If
         i = i + 1
     Loop
 End Sub

(半平太) 2023/01/26(木) 23:59:12


 解決済みかとは思いますが、別案です。

 作業用シートを使うことにして、
   (a)"生徒情報"シート
          ↓ (項目作成、転記)
   (b)"作業用"シート       2段組ではなく、1段のフラットなシート
          ↓  (転記)
   (c)"授与台帳"シート     10行ごとに、コピーペイストします。
 としたらどうでしょう。

 ■
     Dim myRow&, myCol&
     Dim wsTemp As Worksheet
   といった変数を宣言しておき、
     Set wsTemp = Worksheets("作業") ' ■■事前に作成しておいてください。列の書式も適正にセットのこと
   としておきます。

 ■ 主要な転記部分のみ示します。(正式名称とかの対応は、説明目的を優先して省略しています)

     Rem ■(1)"生徒情報"シートをもとに、"作業"シートに対象者の情報を作成します-----
     wsTemp.Cells.ClearContents  '転記先を初期化(必要なら、書式は事前に整えておいてください)
     j = 1
     For i = 189 To wsS.Cells(Rows.Count, "Q").End(xlUp).Row     '189は直接書きました(追加再検討が必要)
         名前 = wsS.Cells(i, 17).Value
         生年月日 = Format(wsS.Cells(i, 22).Value, "ggge年m月d日")
         wsTemp.Cells(j, "A").Value = "第" & 証書番号 & "号"
         wsTemp.Cells(j, "B").Value = 卒業年 & vbCrLf & "3月31日"
         wsTemp.Cells(j, "C").Value = 名前
         wsTemp.Cells(j, "D").Value = 生年月日 & "生"
         証書番号 = 証書番号 + 1
         j = j + 1
     Next

     Rem ■(2)"作業"シートの情報を、"授与台帳"シートに転記------------------

     '最初の転記先位置
     myRow = 6
     myCol = 1

     For k = 1 To wsTemp.Cells(Rows.Count, "A").End(xlUp).Row Step 10
         wsTemp.Cells(k, "A").Resize(10, 4).Copy wsJ.Cells(myRow, myCol)

         '次の転記先位置を決める
         If myCol = 1 Then
             myCol = 7
         ElseIf myCol = 7 Then
             myCol = 1
             myRow = myRow + 10
         End If
     Next
 End Sub
  
(γ) 2023/01/27(金) 07:18:38

書き込む方をループ化させる場合の簡単なサンプルです。
(2次元配列化されたデータを入力することを想定したものです。)

 Sub Sample()
    Const TOP_ROW As Long = 6   '先頭行
    Const TOP_COL As Long = 1   '先頭列
    Const IV_COL  As Long = 6   '列間隔
    Const COL_DIV As Long = 2   '列分割数
    Const ROW_DIV As Long = 10  '何人ごとに列変更するか

    Dim cnt As Long
    Dim iCl As Long, iRw As Long
    Dim i As Long, j As Long, k As Long
    Dim r As Long, c As Long

    cnt = Application.InputBox("データ数を入力", Type:=1)

    For i = 0 To (cnt - 1) \ (COL_DIV * ROW_DIV)
        For j = 0 To COL_DIV - 1
            iCl = j * IV_COL + TOP_COL
            For k = 0 To ROW_DIV - 1
                r = i * (COL_DIV * ROW_DIV) + j * ROW_DIV + k
                If r >= cnt Then Exit For
                iRw = i * ROW_DIV + k + TOP_ROW
                For c = 0 To 3
                    Cells(iRw, iCl + c).Value = "Array(" & r & "," & c & ")"
                Next
            Next k
        Next j
    Next i
 End Sub
(お邪魔します) 2023/01/27(金) 11:54:24

これって合ってるの ?

    |[A]       |[B]       |[C]       |[D]       
 [1]|          |          |          |          
 [2]|Array(0,0)|Array(0,1)|Array(0,2)|Array(0,3)
 [3]|Array(1,0)|Array(1,1)|Array(1,2)|Array(1,3)
 [4]|Array(2,0)|Array(2,1)|Array(2,2)|Array(2,3)

    Const Top_Row As Long = 2   '先頭行
    Const Top_Columns As Long = 1   '先頭列
    Const 列間隔  As Long = 3   '列間隔
    Const 列分割数 As Long = 2   '列分割数
    Const 何人ごとに列変更するか As Long = 10  '何人ごとに列変更するか

    cnt = Application.InputBox("データ数を入力", Type:=1)
    cnt=3

'==================================================================================

     |[A]       |[B]       |[C]       |[D]        |[E]        |[F]        |[G]        
 [1] |          |          |          |           |           |           |           
 [2] |Array(0,0)|Array(0,1)|Array(0,2)|Array(10,0)|Array(10,1)|Array(10,2)|Array(10,3)
 [3] |Array(1,0)|Array(1,1)|Array(1,2)|Array(11,0)|Array(11,1)|Array(11,2)|Array(11,3)
 [4] |Array(2,0)|Array(2,1)|Array(2,2)|Array(12,0)|Array(12,1)|Array(12,2)|Array(12,3)
 [5] |Array(3,0)|Array(3,1)|Array(3,2)|Array(13,0)|Array(13,1)|Array(13,2)|Array(13,3)
 [6] |Array(4,0)|Array(4,1)|Array(4,2)|Array(14,0)|Array(14,1)|Array(14,2)|Array(14,3)
 [7] |Array(5,0)|Array(5,1)|Array(5,2)|Array(5,3) |           |           |           
 [8] |Array(6,0)|Array(6,1)|Array(6,2)|Array(6,3) |           |           |           
 [9] |Array(7,0)|Array(7,1)|Array(7,2)|Array(7,3) |           |           |           
 [10]|Array(8,0)|Array(8,1)|Array(8,2)|Array(8,3) |           |           |           

    Const Top_Row As Long = 2   '先頭行
    Const Top_Columns As Long = 1   '先頭列
    Const 列間隔  As Long = 3   '列間隔
    Const 列分割数 As Long = 2   '列分割数
    Const 何人ごとに列変更するか As Long = 10  '何人ごとに列変更するか

    cnt = Application.InputBox("データ数を入力", Type:=1)
    cnt=15

(やってみた) 2023/01/27(金) 12:55:56


こんにちわ。^^
諸先輩様のスマートなコードの後で、汗顔の至りですが、お勉強の
成果発表を。。。算数は引き算、足し算くらいしか解らない、プロ
グラミングも中途半端な、老人が書くとこうなりました。( ̄▽ ̄;)
間違っていましたら、お許しを。m(__)m
でわ
 Option Explicit
Sub DataBaseColumns_WrightToOherWorkSheetAandG_Main()
    Dim v()           As Variant
    Dim aAry()        As Variant
    Dim gAry()        As Variant
    Dim sKipv         As Long
    sKipv = 10
    wSDataSet v
    dPickOut v, aAry(), gAry, sKipv
    rEsultWriteOutToWs aAry, gAry
    Erase v, aAry, gAry
End Sub
Private Sub wSDataSet(v() As Variant)
    Dim r             As Range
    With Worksheets("生徒情報")
        Set r = .Cells(1).CurrentRegion
        Set r = r.Offset(1).Resize(r.Rows.Count - 1)
        v = r.Value
    End With
End Sub
Private Sub dPickOut(v() As Variant, aAry() As Variant, gAry() As Variant, ByVal skv As Long)
    Dim aFlg          As Boolean
    Dim i             As Long
    Dim j             As Long
    Dim var           As Variant
    Dim a             As Long
    Dim g             As Long
    Dim cnt           As Long
    Dim 証書番号      As Long
    Dim 卒業年        As String
    Dim 最高学年      As Long
    Dim 名前          As String
    Dim 生年月日      As Variant
    証書番号 = 1
    卒業年 = Format(Now, "ggge年")
    最高学年 = Worksheets("データベース").Cells(11, 2).Value
    If skv < 1 Then Exit Sub
    aFlg = True
    For i = 1 To UBound(v, 1)
        If v(i, 3) = 最高学年 Then
            cnt = cnt + 1
        'MsgBox i

            名前 = v(i, 17)
            生年月日 = Format(v(i, 22), "ggge年m月d日")
            If v(i, 19) <> "" Then 名前 = v(i, 19)
            var = Array("第" & 証書番号 & "号", 卒業年 & vbCrLf & "3月31日", 名前, 生年月日 & "生")
            dPickOut_Sub_DivWrightData var, aFlg, aAry, gAry, a, g
            Erase var
            If cnt Mod skv = 0 Then
                dPickOut_Sub_SetFlg aFlg
            End If
            証書番号 = 証書番号 + 1
        End If

        If cnt Mod 32 = 0 Then DoEvents
    Next
End Sub
Private Sub dPickOut_Sub_DivWrightData(ByVal var As Variant, _
                                       ByVal aFlg As Boolean, _
                                       ByRef aAry() As Variant, _
                                       ByRef gAry() As Variant, _
                                       ByRef a As Long, _
                                       ByRef g As Long)
    If aFlg Then
        ReDim Preserve aAry(a)
        aAry(a) = var
        a = a + 1
    Else
        ReDim Preserve gAry(g)
        gAry(g) = var
        g = g + 1
    End If
End Sub
Private Sub dPickOut_Sub_SetFlg(ByRef aFlg As Boolean)
    If aFlg Then
        aFlg = False
    Else
        aFlg = True
    End If
End Sub
Private Sub rEsultWriteOutToWs(aAry(), gAry())
    ReDim w1(1 To UBound(aAry) + 1, 1 To 5)
    ReDim w2(1 To UBound(gAry) + 1, 1 To 5)
    Dim i             As Long
    Dim j             As Long
    For i = LBound(aAry) To UBound(aAry)
        For j = LBound(aAry(i)) To UBound(aAry(i))
            w1(i + 1, j + 1) = aAry(i)(j)
        Next
    Next
    For i = LBound(gAry) To UBound(gAry)
        For j = LBound(gAry(i)) To UBound(gAry(i))
            w2(i + 1, j + 1) = gAry(i)(j)
        Next
    Next
    With Worksheets("授与台帳")
        .UsedRange.Clear
        .Cells(6, 1).Resize(UBound(w1, 1), UBound(w1, 2)) = w1
        .Cells(6, 7).Resize(UBound(w2, 1), UBound(w2, 2)) = w2
    End With
    Erase w1, w2
End Sub
大変な間違いを致しておりましたのでコードを修正致しました
14:35 頃 ^^;。。。m(__)mm(__)mm(__)m
(隠居Z) 2023/01/27(金) 13:07:27

皆様、様々な解答、別解をどうもありがとうございます。
do loopとifくらいしか知らない私にとってはチャレンジになる記述ですが、勉強させていただいております。
高校数学で学んだmodがVBAには登場し、こういう場面で役立つとは目からうろこでした。
(るっく) 2023/01/27(金) 22:06:19

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.