Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4578 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【55845】特定の行を、任意の複数箇所に挿入・コピーする方法 taro 08/5/21(水) 11:32 質問[未読]
【55846】Re:特定の行を、任意の複数箇所に挿入・コ... テト 08/5/21(水) 11:54 発言[未読]
【55853】Re:特定の行を、任意の複数箇所に挿入・コ... taro 08/5/21(水) 13:47 発言[未読]
【55855】Re:特定の行を、任意の複数箇所に挿入・コ... テト 08/5/21(水) 13:56 発言[未読]
【55860】Re:特定の行を、任意の複数箇所に挿入・コ... taro 08/5/21(水) 14:18 お礼[未読]
【55849】Re:特定の行を、任意の複数箇所に挿入・コ... kanabun 08/5/21(水) 13:29 発言[未読]
【55852】Re:特定の行を、任意の複数箇所に挿入・コ... taro 08/5/21(水) 13:46 発言[未読]
【55859】Re:特定の行を、任意の複数箇所に挿入・コ... kanabun 08/5/21(水) 14:11 発言[未読]
【55861】Re:特定の行を、任意の複数箇所に挿入・コ... taro 08/5/21(水) 14:19 お礼[未読]
【55845】特定の行を、任意の複数箇所に挿入・コピ...
質問  taro  - 08/5/21(水) 11:32 -
引用なし
パスワード
   いきなりの具体例で恐縮です。
例えば、以下のような表があるとします。

　　A　　　　　　　B　　　C　　
1　表タイトル1
2　表タイトル2
3　整理番号　　　項目1　項目2　
4　21　　　　　　　--　　--　
5　21　　　　　　　--　　--　
6　22　　　　　　　--　　--
7　22　　　　　　　--　　--
8　23　　　　　　　--　　--
9　23　　　　　　　--　　--

このとき、A列（整理番号）が変わる行を境に、1・2行目（表タイトル1・
表タイトル2）を行ごと挿入コピーしたい場合、どのようにマクロを書けば
いいでしょうか。
上の例では、
　*　5行目と6行目の間に、1・2行目を行の挿入・コピーをする
　*　7行目と8行目の間に、1・2行目を行の挿入・コピーをする
ということになります。

なお、他の前提条件は以下のとおりです。
　*　21・22・23の整理番号は、この3つだけでなく約20種類あること
　*　それぞれの整理番号の行数は、整理番号によって異なること
　*　毎月1回の更新処理を想定していて、同じ整理番号でも月によって
　　 行数は変動すること

丸投げのような質問で恐縮ですが、どなたかご教授いただければ
幸いです。
よろしくお願いいたします。
【55846】Re:特定の行を、任意の複数箇所に挿入・...
発言  テト  - 08/5/21(水) 11:54 -
引用なし
パスワード
   こんなのどう？

――――――――――――――――――――――――――――――
Dim iRow As Long

Application.ScreenUpdating = False

For iRow = 4 To Range("A1").End(xlDown).Row
　　With Range("A" & iRow)
　　　　If .Value = .Offset(-1).Value Then
　　　　　　Range("A1:A2").EntireRow.Copy
　　　　　　.Offset(1).EntireRow.Insert xlDown
　　　　　　iRow = iRow + 1
　　　　End If
　　End With
Next iRow

Application.ScreenUpdating = True
Application.CutCopyMode = xlCopy
――――――――――――――――――――――――――――――
【55849】Re:特定の行を、任意の複数箇所に挿入・...
発言  kanabun  - 08/5/21(水) 13:29 -
引用なし
パスワード
   >例えば、
以下のようなケースではどうなればいいのでしょう。

　　A　　　　　　　B　　　C　　
1　表タイトル1
2　表タイトル2
3　整理番号　　　項目1　項目2　
4　21　　　　　　　--　　--　
5　22　　　　　　　--　　--　
6　22　　　　　　　--　　--
7　22　　　　　　　--　　--
8　23　　　　　　　--　　--
9　23　　　　　　　--　　--
10 23　　　　　　　--　　--
11 23　　　　　　　--　　--
12 25　　　　　　　--　　--

行挿入や行削除は 下から見ていったほうが楽な気がします。
【55852】Re:特定の行を、任意の複数箇所に挿入・...
発言  taro  - 08/5/21(水) 13:46 -
引用なし
パスワード
   ▼kanabun さん：
ありがとうございます。
下記のような形です。

　　A　　　　　　　B　　　C　　
1　表タイトル1
2　表タイトル2
3　整理番号　　　項目1　項目2　
4　21　　　　　　　--　　--　
5　表タイトル1
6　表タイトル2
7　22　　　　　　　--　　--　
8　22　　　　　　　--　　--
9　22　　　　　　　--　　--
10　表タイトル1
11　表タイトル2
12　23　　　　　　　--　　--
13　23　　　　　　　--　　--
14　23　　　　　　　--　　--
15　23　　　　　　　--　　--
16　表タイトル1
17　表タイトル2
18　25　　　　　　　--　　--
【55853】Re:特定の行を、任意の複数箇所に挿入・...
発言  taro  - 08/5/21(水) 13:47 -
引用なし
パスワード
   ▼テト さん：

ありがとうございます。
これから試してみます。
【55855】Re:特定の行を、任意の複数箇所に挿入・...
発言  テト  - 08/5/21(水) 13:56 -
引用なし
パスワード
   失礼しました。
上記で載せたコードでは、不具合があったので訂正です。
これで出来ると思うんだけど…。

――――――――――――――――――――――――――――――
Dim iRow As Long

Application.ScreenUpdating = False
iRow = 5

Do
　　With Range("A" & iRow)
　　　　If Not .Value = .Offset(-1).Value Then
　　　　　　Range("A1:A2").EntireRow.Copy
　　　　　　.EntireRow.Insert xlDown
　　　　　　iRow = iRow + 2
　　　　End If
　　　　iRow = iRow + 1

　　　　If .End(xlDown).Row = Rows.Count Then
　　　　　 Exit Do
　　　　End If
　　End With
Loop

Application.ScreenUpdating = True
Application.CutCopyMode = xlCopy
――――――――――――――――――――――――――――――
【55859】Re:特定の行を、任意の複数箇所に挿入・...
発言  kanabun  - 08/5/21(水) 14:11 -
引用なし
パスワード
   ▼taro さん：
> 下記のような形です。

ちがってたらごめんなさい。

下から挿入
　Dim c As Range
　Dim i As Long, LastRow As Long
　
　Set c = Rows("1:2")
　LastRow = Cells(Rows.Count, 1).End(xlUp).Row
　For i = LastRow To 4 + 1 Step -1
　　If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
　　　　c.Copy
　　　　Rows(i).Insert
　　End If
　Next
　Application.CutCopyMode = True
【55860】Re:特定の行を、任意の複数箇所に挿入・...
お礼  taro  - 08/5/21(水) 14:18 -
引用なし
パスワード
   ▼テト さん：

ありがとうございます。
改めてアップしてくださったコードで解決しました。
ご面倒をおかけしました。助かりました。
【55861】Re:特定の行を、任意の複数箇所に挿入・...
お礼  taro  - 08/5/21(水) 14:19 -
引用なし
パスワード
   ▼kanabun さん：

ありがとうございます。
テトさんとは違う方法ですが、同じように私の悩みは解決しました。
勉強になりました。
ご面倒をおかけしました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4578 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free