Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Access 2016)
縦横追加のつづき
投稿日時: 18/11/23 21:41:20
投稿者: sim2018

お世話になります。
前回 縦横追加でデーブル間の追加はできるようになったのですが、指定した列まで追加すると次の行に追加していく方法をいろいろと試してみたのですが、なかなかうまくいきません。
また、どなたかわかられる方がいらっしゃいましたらご教授お願いいたします。
 
TEST(テーブル)
番号 氏名 カナ 参加 日付
 1  あ  ア  〇  11/16
 1  い  イ  ×  11/16
 1  か  カ  〇  11/16
 1  き  キ  ×  11/16
2  う  ウ  〇  11/16
 3  え  エ  〇  11/16
 ・  ・  ・  ・  ・
TESTWK(テーブル)
番号 氏名1 カナ1 参加1 日付1 氏名2 カナ2 参加2 日付2 氏名3 カナ3 参加3 日付3  ← 3回横に追加したら次の行に追加
 1  あ  ア  〇  11/16    い   イ  ×  11/16   か  カ   ×  11/16
1  き  キ  〇  11/16 
 2  う  ウ  〇  11/16
 3  え  エ  〇  11/16
 ・  ・  ・  ・  ・
このようなイメージです。
 
前回下記のように教えて頂きTESTからTESTWKに追加できるようになりました。
Private Sub ‗印刷Click()
  
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim lngIdx As Long
    Dim strSQL As String
     
    Set db = CurrentDb
     strSQL = "SELECT [番号]" & _
             " FROM [TEST]" & _
             " WHERE [番号] IS NOT NULL" & _
             " GROUP BY [番号]" & _
             " ORDER BY [番号]"
              
    
    Set rs1 = db.OpenRecordset(strSQL, dbOpenDynaset)
      
    Set rs2 = db.OpenRecordset("TESTWK", dbOpenDynaset)
      
    Do Until rs1.EOF
        strSQL = "SELECT *" & _
         " FROM [TEST]" & _
         " WHERE [番号] = '" & rs1![番号] & "'" & _
         " ORDER BY [氏名]"
  
                  
        Set rs3 = db.OpenRecordset(strSQL, dbOpenDynaset)
        lngIdx = 1
          
        rs2.AddNew
        rs2![番号] = rs1![番号]
        Do Until (rs3.EOF) Or (lngIdx > 20)
            rs2.Fields("氏名" & lngIdx) = rs3![ 氏名]
            rs2.Fields("カナ" & lngIdx) = rs3![カナ]
            rs2.Fields("参加" & lngIdx) = rs3![参加]
            rs2.Fields("日付" & lngIdx) = rs3![日付]
            rs3.MoveNext
            lngIdx = lngIdx + 1
        Loop
        rs2.Update
          
        Set rs3 = Nothing
        rs1.MoveNext
    Loop
      
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set db = Nothing
  
End Sub
 
Du Loopで回数をしていして追加するのはわかるのですが、今ひとつうまくいきません。
どなたか宜しくお願い致します。
 

回答
投稿日時: 18/11/25 01:31:32
投稿者: mayu.

引用:

> 指定した列まで追加すると次の行に追加していく方法
> 3回横に追加したら次の行に追加

番号毎に、TESTWKテーブルへ追加される行数と変動する最終行の列数は
番号毎のデータ件数から導き出せる
ということは ご理解いただいてるものと解釈します。
 
Sub sample()
    Const HORIZON_LIMIT As Long = 3
    Dim db        As DAO.Database
    Dim rs1       As DAO.Recordset
    Dim rs2       As DAO.Recordset
    Dim i         As Long
    Dim j         As Long
    Dim k         As Long
    Dim x         As Long
    Dim iRow      As Long
    Dim iCol      As Long
    Dim itemCount As Long
    Dim strSQL    As String
    Dim v         As Variant
    Dim items     As Variant
    
    If (DCount("*", "TEST", "番号 Is Not Null") = 0) Then Exit Sub
    
    Set db = CurrentDb
    db.Execute "DELETE FROM TESTWK ;"
    
    strSQL = "SELECT 番号, Count(1) " _
           & "FROM TEST " _
           & "WHERE 番号 Is Not Null " _
           & "GROUP BY 番号 " _
           & "ORDER BY 番号 ;"
    
    Set rs1 = db.OpenRecordset(strSQL, dbOpenSnapshot)
    rs1.MoveLast
    rs1.MoveFirst
    v = rs1.GetRows(rs1.RecordCount)
    rs1.Close
    
    items = Array("氏名", "カナ", "参加", "日付")
    itemCount = UBound(items) + 1
    
     strSQL = "SELECT 番号, " & Join(items, ",") & " " _
            & "FROM TEST " _
            & "WHERE 番号 Is Not Null " _
            & "ORDER BY 番号, " & items(0) & " ;"
    
    Set rs1 = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set rs2 = db.OpenRecordset("TESTWK", dbOpenTable)
    
    For i = 0 To UBound(v, 2)
        iRow = -Int(-v(1, i) / HORIZON_LIMIT)
        
        For j = 1 To iRow
            iCol = HORIZON_LIMIT - 1
            If (j = iRow) Then
                iCol = (v(1, i) - 1) Mod HORIZON_LIMIT
            End If
            
            rs2.AddNew
            rs2.Fields(0).Value = v(0, i)
            For k = 0 To iCol
                For x = 0 To itemCount - 1
                    rs2.Fields(1 + (k * itemCount) + x).Value _
                        = rs1.Fields(1 + x).Value
                Next x
                rs1.MoveNext
            Next k
            rs2.Update
        Next j
    Next i
    
    rs1.Close
    rs2.Close
    db.Close
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set db = Nothing
End Sub

投稿日時: 18/11/25 07:19:29
投稿者: sim2018

お世話になります。
早速の返信ありがとうございます。
mayuさんの構文で記述してみましたが、「パラメータが少なすぎます、1を指定してください」と
メッセージがでました。
どこか間違えているのでしょうか?
すみませんまたよろしくお願いいたします。

回答
投稿日時: 18/11/25 07:55:40
投稿者: mayu.

引用:

「パラメータが少なすぎます、1を指定してください」と
メッセージがでました。
どこか間違えているのでしょうか?

間違っているというより
テーブル名 及び フィールド構成が
2018/11/23 21:41:20 に掲載されている
 
引用:

TEST(テーブル)
番号 氏名 カナ 参加 日付

引用:

TESTWK(テーブル)
番号 氏名1 カナ1 参加1 日付1 氏名2 カナ2 参加2 日付2 氏名3 カナ3 参加3 日付3

とは異なっているのでしょう。

投稿日時: 18/11/25 10:22:39
投稿者: sim2018

お世話になります。
ご指摘の通りフィールド名をまちがえていました。
 
3回で次の行にデータが追加されていましたが、上記の構文のどこで3回というのが記述してあるのでしょうか?
実際には32回追加した後に次の行に追加するようにしています。
 
初歩的に質問ですみません、宜しくお願い致します。

回答
投稿日時: 18/11/25 10:35:14
投稿者: mayu.

引用:

3回で次の行にデータが追加されていましたが、
上記の構文のどこで3回というのが記述してあるのでしょうか?
実際には32回追加した後に次の行に追加するようにしています。

Const HORIZON_LIMIT As Long = 3
 
プロシージャの先頭行に定義しています。
32回追加するのでしたら、ここの数値を 32 に変更すればよろしいでしょう。

投稿日時: 18/11/26 06:15:00
投稿者: sim2018

お世話になります。
返事が遅くなりましたが、出来ました。
 
mayuさん本当にありがとうございました。