[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『行数を増やす（データによって増やす行数が違う）』（JUN）
こんにちは。下に記載されたものをベースにマクロを再度組もうと思っています。
最終的にやりたいことは「ワードの差し込み文書のデータ作り」です。
営業店に【店名・電話番号】がすでに入っている印刷物を配布する予定があり、営業店ごとに印刷したい枚数が違うので、データ横に置く枚数分行数を増やし、そのデータをワードに差し込むことで全店分一気に印刷したいと考えています。
(下に書いたマクロは前回作ったものですが、今回は量が増えたため改変できればと思っています)
しかし、これだとInputBoxから数を取得することと、営業店ごとに増やす数を逐一入力しなければならないので一気にできた方が便利かと考えました。
すべて行が増えた状態で2500行くらいになる予定です。
質問は
・やりたいことはこれの改編で可能か
・改編する場所は枚数取得の場所とコピーの貼り付けのみか
【イメージ】
A B C D
店番 店名 電話番号 枚数
195 東京 XXXX 10←これを10行に
196 千葉 YYYY 5←これを5行に
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Sub 同一行コピーを増やして連続させる()
'A列最終行の取得（LstRow = Cells（）の中の1を調整。Bなら2）
Dim LstRow As Long
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
'印刷枚数をInputBoxから取得
Dim a As Long
a = Application.InputBox("枚数入力", Type:=1)
'InputBoxの引数が2より小さ場合、終了する。
If a < 2 Then
MsgBox "有効でない数値が入力されました。"
End
End If
'aを増やす行数に変換する。
a = a - 1
'選択したセルのコピーを次の行にa分貼り付け
For i = 1 to a
Rows(ActiveCell.Row).Copy Destination:=Rows(ActiveCell.Row + i)
Next i
Application.CutCopyMode = False
End Sub
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
ネットにあったこれを「選択したセルのコピーを次の行にa分貼り付け」と差し替えることでやりたいことには少し近づくのかとも考えています。
'繰り返し処理（見出し行ありを「LastRow to 2」で調整、見出しがなければ「to 1」）
For i = LstRow To 2 Step -1
Rows(i).Select
Selection.Copy
Rows(i + 1 & ":" & i + a).Select
Selection.Insert Shift:=xlDown
ご教授頂ければ幸いです。
長文となり申し訳ございません。よろしくお願い致します。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
（マナ） 2021/02/14(日) 17:23
また、店の数が140店舗以上あり、多いところでは一つの店の行を100行程に増やす必要があるので、ボタン一つで差込データが完成する方が後々効率的であると考えました。
しかし、マクロ以外で良い案があれば教えていただけると助かります。
前回は店番を入れれば店名と電話番号が出るように設定しておき、１行分情報を出してからそれを増やすというやり方を取りましたが、それを140回繰り返すのは少々手間だったのでもう少し効率化したいです。
（JUN） 2021/02/14(日) 17:35
Power Quereyで、表の加工を自動化する案です。
https://hamachan.info/win8-excel2013-powerquery/
１）現在のデータをテーブルに設定
２）「POWER QUERY」-「テーブル/範囲から」
これでPower Queryエディターにデータが取り込む
３）カスタム列を追加
新しい列名: index
式：= List.Numbers(1,[枚数])
４）[index]列を、新しい行に展開 ５）[枚数]列を削除 ６）閉じて読み込む ７）出力結果
店番 店名 電話番号 index 195 東京 XXXX 1 195 東京 XXXX 2 195 東京 XXXX 3 195 東京 XXXX 4 195 東京 XXXX 5 195 東京 XXXX 6 195 東京 XXXX 7 195 東京 XXXX 8 195 東京 XXXX 9 195 東京 XXXX 10 196 千葉 YYYY 1 196 千葉 YYYY 2 196 千葉 YYYY 3 196 千葉 YYYY 4 196 千葉 YYYY 5 196 千葉 YYYY 2
８）元データを変更したら、出力したテーブル内で右クリックし「更新」
９）はじめてで、Power Queryの操作がよくわからなかったら、
詳細エディターに、下記をコピペ
let
ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
変更された型 = Table.TransformColumnTypes(ソース,{{"店番", Int64.Type}, {"店名", type text}, {"電話番号", type text}, {"枚数", Int64.Type}}),
追加されたカスタム = Table.AddColumn(変更された型, "index", each List.Numbers(1,[枚数])),
#"展開された index" = Table.ExpandListColumn(追加されたカスタム, "index"),
削除された列 = Table.RemoveColumns(#"展開された index",{"枚数"})
in
削除された列
（マナ） 2021/02/14(日) 17:52
マクロの方も待ってみようと思います。
すぐにご回答いただき、本当にありがとうございます。
（JUN） 2021/02/14(日) 18:03
Sub test()
Dim wsF As Worksheet
Dim wsT As Worksheet
Dim tbl As Range
Dim r As Range
Dim n As Long
Set wsF = Worksheets("Sheet1")
Set wsT = Worksheets("Sheet2")
wsT.UsedRange.Offset(1).ClearContents
Set tbl = wsF.Cells(1).CurrentRegion
Set tbl = Intersect(tbl, tbl.Offset(1))
For Each r In tbl.Rows
n = r.Cells(4).Value
r.Resize(, 3).Copy wsT.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(n)
Next
End Sub
（マナ） 2021/02/14(日) 19:53
本当にありがとうございました。
（JUN） 2021/02/14(日) 22:45
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.