ACCESS もしくはEXCEL条件によってコピー

質問

ACCESSもしくはEXCELで　口数の数量と同じようにそのデータ(行)をコピーしたいですが、お願い致します。
例：
住所　　　名前　　　口数
東京　　　XX　XX　　２
千葉　　　YY　YY　　1
神奈川　　ZZ　ZZ　　3

を下の表ようにしたいです。
住所　　　名前　　　口数
東京　　　XX　XX　　１
東京　　　XX　XX　　１
千葉　　　YY　YY　　１
神奈川　　ZZ　ZZ　　1
神奈川　　ZZ　ZZ　　１
神奈川　　ZZ　ZZ　　１

口数と同じようにその行を全部コピーしたですが、
宜しくお願い致します。

回答No.1

piroin654 · ベストアンサー

Accessでの方法ですが。
DAOを使用するので、コード表の「ツール」から
「参照設定」を選択し、
Microsoft DAO xx Object Library
にチェックが入っているか確認してください。
xxは3.6のような数字です。

テーブル名は実際に合わせて変更してください。
以下を標準モジュールに貼り付け保存し、
イミディエイトウィンドウで実行してみてください。
あるいは、中身をフォームのボタンクリックの
イベントで実行してもかまいませんが。

なお、「口数」は数値型であるという前提にしています。
以下ではテーブル1と同じ構造のテーブルを用意し、名前を
テーブル2としています。

Sub test()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim i As Long

Set db = CurrentDb
Set rs1 = db.OpenRecordset("テーブル1")
Set rs2 = db.OpenRecordset("テーブル2", dbOpenDynaset)

If rs1.RecordCount > 0 Then
　　rs1.MoveFirst
　　Do Until rs1.EOF
　　If Not rs1!口数 = 0 Then
　　　　For i = 1 To rs1!口数
　　　　　　rs2.AddNew
　　　　　　　　rs2!住所 = rs1!住所
　　　　　　　　rs2!名前 = rs1!名前
　　　　　　　　rs2!口数 = 1
　　　　　　rs2.Update
　　　　Next i
　　End If
　　rs1.MoveNext
　　Loop
End If
rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
db.Close: Set db = Nothing
End Sub

なにかあれば補足してください。

回答No.4

30246kiku

Access でのものになりますが、
同一テーブルで処理するものになります。

口数 > 1 のレコードを求めておいて、
口数 - 1 を iCnt に覚えてから、口数を 1 に変更
その変更したレコード全フィールドを iCnt 数分コピー
コピー先は rs の Clone の rsC にしているので単純ループでフィールド全部
（もし、オートナンバのフィールドがあったら、除外するようにします）

Public Sub test()
　　Dim rs As New ADODB.Recordset
　　Dim rsC As ADODB.Recordset
　　Dim i As Long, iCnt As Long, j As Long, k As Long

　　rs.Source = "SELECT * FROM テーブル名 WHERE 口数>1;"
　　rs.Open , CurrentProject.Connection, adOpenStatic, adLockOptimistic
　　If (Not rs.EOF) Then
　　　　Set rsC = rs.Clone
　　　　For i = 1 To rs.RecordCount
　　　　　　iCnt = rs("口数") - 1
　　　　　　rs("口数") = 1
　　　　　　rs.Update
　　　　　　For j = 1 To iCnt
　　　　　　　　rsC.AddNew
　　　　　　　　For k = 0 To rs.Fields.Count - 1
　　　　　　　　　　rsC(k) = rs(k)
　　　　　　　　Next
　　　　　　　　rsC.Update
　　　　　　Next
　　　　　　rs.MoveNext
　　　　Next
　　　　rsC.Close
　　　　Set rsC = Nothing
　　End If
　　rs.Close
End Sub

回答No.3

keithin

エクセルを使ってＣ列に口数として。

ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim i as long
　dim c as long

　for i = range("C65536").end(xlup).row to 2 step -1
　　for c = 1 to val(cells(i, "C"))
　　　rows(i).copy
　　　rows(i + 1).insert
　　　cells(i + 1, "C") = 1
　　next c
　　rows(i).delete shift:=xlshiftup
　next i
end sub

ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８を押してマクロを実行する。

＃ベタで一番簡単なマクロです。

回答No.2

piroin654

No1です。
口数が0の場合があるのかはわからないので
はずしておきましたが、もし0の場合があるとして
それもコピーするならば、以下のようにしてみてください。
そのあたりのことは、明記されていないのでこれ以上の
深読みは避けておきますが。

Sub test()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim i As Long

Set db = CurrentDb
Set rs1 = db.OpenRecordset("テーブル1")
Set rs2 = db.OpenRecordset("テーブル2", dbOpenDynaset)

If rs1.RecordCount > 0 Then
　　rs1.MoveFirst
　　Do Until rs1.EOF
　　If Not rs1!口数 = 0 Then
　　　　For i = 1 To rs1!口数
　　　　　　rs2.AddNew
　　　　　　　　rs2!住所 = rs1!住所
　　　　　　　　rs2!名前 = rs1!名前
　　　　　　　　rs2!口数 = 1
　　　　　　rs2.Update
　　　　Next i
'口数が0である場合
　　Else
　　　　rs2.AddNew
　　　　　　rs2!住所 = rs1!住所
　　　　　　rs2!名前 = rs1!名前
　　　　　　rs2!口数 = rs1!口数
　　　　rs2.Update
　　End If
　　rs1.MoveNext
　　Loop
End If
rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
db.Close: Set db = Nothing
End Sub