A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
こんばんは!
すでに回答は出ていますが・・・
コピー&ペーストにするとかなりの時間を要すると思います。
値の代入にしてみました。
元データはSheet1にあり、Sheet2に表示するとしています。
標準モジュールにしてください。
Sub Sample1()
Dim i As Long, j As Long, lastRow As Long
Dim myRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
lastRow = .Cells(Rows.count, "A").End(xlUp).row
If lastRow > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, "H")).ClearContents
End If
For i = 2 To wS.Cells(Rows.count, "A").End(xlUp).row
myRow = .Cells(Rows.count, "A").End(xlUp).row + 1
For j = 1 To 8 '//A列~H列まで//
If wS.Cells(i, "D") > 0 Then
.Cells(myRow, j).Resize(wS.Cells(i, "D") + 1).Value = wS.Cells(i, j).Value '//★//
Else
.Cells(myRow, j).Value = wS.Cells(i, j).Value
End If
Next j
Next i
.Activate
End With
MsgBox "完了"
End Sub
※ 仮にD列に「3」という数値がある場合、同じデータが4行できるコトになりますが、
これで良いのでしょうか?
もし、D列の行数だけ!というのであれば、コード内の「★」の行を
>.Cells(myRow, j).Resize(wS.Cells(i, "D")).Value = wS.Cells(i, j).Value
としてみてください。m(_ _)m
No.4
- 回答日時:
こんな感じはいかがですか?
-----------------------------------------------------------------------------------------
Sub Sample()
Dim 行 As Long
Dim 残数 As Long
Application.ScreenUpdating = False
For 行 = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
残数 = Cells(行, 4).Value
Do While 残数 > 0
Range(Cells(行, 1), Cells(行, 8)).Copy
Range(Cells(行, 1), Cells(行, 8)).Insert Shift:=xlDown
残数 = 残数 - 1
Loop
Next
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------------------------------
※ 行追加の場合は下から行う方が、行番号が変化しないのでお勧めです。
※「Application.ScreenUpdating = False」と「Application.ScreenUpdating = True」は画面書き換えを停止させスピードアップを図っています。
No.3
- 回答日時:
同じシートにした場合、リラン(マクロの再実行)ができなくなるので、Sheet2へコピーするようにしました。
Sheet2が正しく作成されているのを確認後、Sheet2のシート名を正しいものに変えてください。
下記マクロを標準モジュールへ登録してください。
マクロ実行時は、提示された画面が表示されている状態で実行してください。
マクロは、アクティブシートのデータをコピーします。
----------------------------------------------------------------------
Option Explicit
Public Sub 行コピー()
Dim ws As Worksheet
Dim maxrow As Long
Dim row As Long
Dim row2 As Long
Dim count As Long
Dim i As Long
Set ws = Worksheets("Sheet2")
ws.Cells.Clear
maxrow = Cells(Rows.count, "D").End(xlUp).row
Rows(1).Copy ws.Rows(1)
row2 = 2
For row = 2 To maxrow
count = Cells(row, "D").Value + 1
For i = 1 To count
Rows(row).Copy ws.Rows(row2)
row2 = row2 + 1
Next
Next
MsgBox ("コピー完了")
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Googleスプレッドシートで、あるセルの値に応じて行を自動挿入したい 急いでいます! くわしい方、 3 2023/03/06 19:05
- その他(Microsoft Office) 関数を教えてください 1 2022/12/13 15:56
- Excel(エクセル) 関数EXACT(文字列,文字列)とexcelVBA 3 2022/04/14 15:07
- Excel(エクセル) VBA 特定の列に入っているテキストをコピペ 2 2023/06/14 11:24
- Excel(エクセル) Excelに文字データのみを貼り付けたい 8 2023/05/03 15:38
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- Excel(エクセル) Excelの文字列を数字に変換する方法について 6 2023/07/31 21:18
- Visual Basic(VBA) Excel vbaについて知恵もしくは、コード教えて下さいm(__)m ① 表にあるデータをコピー、 2 2022/09/01 23:57
- Excel(エクセル) Excel 表の作成について 3 2022/06/16 12:15
- Excel(エクセル) マクロだと数式が表示される 2 2022/09/10 14:48
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで空白行を削除する ...
-
Excel VBAでオートフィルタで抽...
-
Access2003レポート:最終ペー...
-
列から特定の文字列検索→該当以...
-
マクロにて指定の文字間の文字...
-
VBAでの重複データに色付け
-
マクロで最終行を取得してコピ...
-
EXCEL2007マクロ/オートフィル...
-
EXCEL VBAでA列にある空白行よ...
-
【VBA】条件に一致しない行を削...
-
【VBA】条件に一致しない行を削...
-
VBA 複数列コンボボックス 値の...
-
excel2021で実行できないマクロ...
-
エクセルのデータがない行には...
-
Excel VBAで列を行に変換するには
-
エクセルで階層図を作る方法
-
VB.net
-
【VBA】指定月のオートフィルタ...
-
Excel マクロ 検索結果を別シ...
-
VBAで入力の結果を他のセルに反...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで空白行を削除する ...
-
数値に見えるものはすべて数値...
-
エクセルのデータがない行には...
-
マクロで最終行を取得してコピ...
-
【VBA】条件に一致しない行を削...
-
【VBA】条件に一致しない行を削...
-
エクセルのVBAで指定した行数の...
-
VB.net
-
Excel VBAでオートフィルタで抽...
-
マクロにて指定の文字間の文字...
-
Excel97 指定した行だけマク...
-
EXCEL VBAでA列にある空白行よ...
-
excel2021で実行できないマクロ...
-
Excel 別ブックから該当データ...
-
VBAでの重複データに色付け
-
Excel VBA オートフィルタの結...
-
エクセルで階層図を作る方法
-
VBAで特定の行と一つ上の行を削...
-
【至急】Excel 同一人物の情報...
-
Excelで、マウスで範囲を選択し...
おすすめ情報
はい、D3についてその通りです。コピー先はその行の下に挿入コピーする形にしたいです。シートは同じもの大丈夫です。Excelに慣れていないもので、説明不足で申し訳ありません。
はいVBAを使っていただいて問題ありません。間違いありません。D列の数字の分だけ行を追加したいです。宜しくお願いします。