Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2072 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【70176】上の行を書式のみをコピーして、選択した行数分だけ次の行に挿入したい げっち 11/10/18(火) 15:56 質問[未読]
【70177】Re:上の行を書式のみをコピーして、選択し... kanabun 11/10/18(火) 17:22 発言[未読]
【70178】Re:上の行を書式のみをコピーして、選択し... kanabun 11/10/18(火) 17:25 発言[未読]
【70179】Re:上の行を書式のみをコピーして、選択し... げっち 11/10/18(火) 18:55 質問[未読]
【70184】Re:上の行を書式のみをコピーして、選択し... kanabun 11/10/18(火) 21:33 発言[未読]
【70194】Re:上の行を書式のみをコピーして、選択し... げっち 11/10/19(水) 10:13 質問[未読]
【70198】Re:上の行を書式のみをコピーして、選択し... kanabun 11/10/19(水) 11:21 発言[未読]
【70200】Re:上の行を書式のみをコピーして、選択し... げっち 11/10/19(水) 12:23 発言[未読]
【70202】Re:上の行を書式のみをコピーして、選択し... SS 11/10/19(水) 13:55 発言[未読]
【70209】Re:上の行を書式のみをコピーして、選択し... げっち 11/10/19(水) 19:22 お礼[未読]
【70204】Re:上の行を書式のみをコピーして、選択し... kanabun 11/10/19(水) 15:12 発言[未読]
【70176】上の行を書式のみをコピーして、選択した...
質問  げっち  - 11/10/18(火) 15:56 -
引用なし
パスワード
   いつもお世話になっております。

行を追加したい行を選択した後、選択した行の上の行の書式のみを
コピーしたものを、選択した行に貼り付けるマクロを組みました。

具体的には下記のように

Ａ列｜Ｂ列（氏名）｜　Ｃ列（番号）　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
１　｜　山田一郎　｜　　１００　　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
２　｜　山田次郎　｜　　１０１　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
３　｜　山田三郎　｜　　１０２　　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
　　　　上記の書式でないデータ　　　　←この行を選択　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿


Ａ列｜Ｂ列（氏名）｜　Ｃ列（番号）　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
１　｜　山田一郎　｜　　１００　　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
２　｜　山田次郎　｜　　１０１　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
３　｜　山田三郎　｜　　１０２　　　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
　　｜　　　　　　　　｜　　　　　　　　←上の行の書式のみコピーした行
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
　　　　上記の書式でないデータ　　　←選択してた行
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿


このように選択していた上の行の書式のみをコピーして貼り付ける動作を行います。
行を２行選択すると、２行の貼り付けを行うように選択した行の分だけ行を
貼り付けるようにしています。

しかし、動作こそ上手くいくものの挙動がおかしいため、
もっと効率の良いマクロの組み方があればお願い致します。

それに加えて、Ａ列のみオートフィルをかけ、
追加と同時に番号が自動的に振られるようにもしたいです。

マクロは以下の通りです。

Sub Macro1()

　　Dim i As Long
　　Dim RowCnt As Integer

　　RowCnt = Selection.CurrentRegion.Rows.Count - 1 '選択している行数のカウント

　　Selection.Insert Shift:=xlDown
　　
　　For i = 1 To RowCnt
　　
　　　　Selection.Offset(-1).Copy
　　　　Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
　　　　　　SkipBlanks:=False, Transpose:=False
　　　　
　　Next i
　　　　
　　Application.CutCopyMode = False
　　　　
End Sub


分かりにくいかもしれませんが、よろしくお願い致します。
【70177】Re:上の行を書式のみをコピーして、選択...
発言  kanabun  - 11/10/18(火) 17:22 -
引用なし
パスワード
   ▼げっち さん：

>行を追加したい行を選択した後、選択した行の上の行の書式のみを
>コピーしたものを、選択した行に貼り付けるマクロを組みました。

>行を２行選択すると、２行の貼り付けを行うように選択した行の分だけ行を
>貼り付けるようにしています。

現状のコードの問題点ですが

まず、ここがおかしいです。
>　　RowCnt = Selection.CurrentRegion.Rows.Count - 1 '選択している行数のカウント
これでは、「選択してる行の隣接する表領域全体の行数のカウント」
になってしまいます。
たとえば、100行からなる表があって、その50行目を選択したとすると、
選択した行数は1 ですよね。現状のコードですと、100行が返ってきてます。
単に
　　RowCnt = Selection.Rows.Count '選択している行数のカウント
でいいような気がします。

そのため、
>　　For i = 1 To RowCnt
RowCnt回繰り返すのだけど、

いつも選択した行の1行上の行をCopyして、選択行に「書式貼り付け」
という処理をするコードになってます。
　　
>　　　　Selection.Offset(-1).Copy
>　　　　Selection.PasteSpecial Paste:=xlPasteFormats


試してはないので、うまくいくかどうか定かではないのですが、
>　　　　Selection.Offset(-1).Copy
を
　　　　Selection.Offset(-RowCnt).Copy

としてみたらどうでしょう？
【70178】Re:上の行を書式のみをコピーして、選択...
発言  kanabun  - 11/10/18(火) 17:25 -
引用なし
パスワード
   ▼げっち さん：

あ、そうすれば、
>>　　For i = 1 To RowCnt
>>　　Next

のFor〜Nextブロックは不要になるのでは？
という意味でした。
【70179】Re:上の行を書式のみをコピーして、選択...
質問  げっち  - 11/10/18(火) 18:55 -
引用なし
パスワード
   ▼kanabun さん：

回答ありがとうございます。

>
>あ、そうすれば、
>>>　　For i = 1 To RowCnt
>>>　　Next
>
>のFor〜Nextブロックは不要になるのでは？
>という意味でした。

おっしゃる通りFor〜Next文は不要になりました。

ですが、ある程度の多くの行を指定（30行前後の行選択を）すると
貼り付けたセルの一番上のセルが崩れたり、もしくは
「実行時エラー　'1004': アプリケーション定義
またはオブジェクト定義のエラーです」とエラー表示されます。

それと、列が結合されていると書式のみ貼り付けが上手くできないようでした。

これらに対してなにか解決策はありますでしょうか？
【70184】Re:上の行を書式のみをコピーして、選択...
発言  kanabun  - 11/10/18(火) 21:33 -
引用なし
パスワード
   ▼げっち さん：

>ですが、ある程度の多くの行を指定（30行前後の行選択を）すると
>貼り付けたセルの一番上のセルが崩れたり、もしくは
>「実行時エラー　'1004': アプリケーション定義
>またはオブジェクト定義のエラーです」とエラー表示されます。

「貼り付けたセルの一番上のセルが崩れたり...」
のほうはちょっと分かりません。

実行時エラー（アプリケーション定義またはオブジェクト定義エラー）
のほうは、こういうことではありませんか
たとえば、30行目〜60行目までを選択すると、選択された行数は
31行です。（RowCnt = 31）
そのOffset(-RowCount) は何行目ですか？
【70194】Re:上の行を書式のみをコピーして、選択...
質問  げっち  - 11/10/19(水) 10:13 -
引用なし
パスワード
   ▼kanabun さん：

返答ありがとうございます。

>
>「貼り付けたセルの一番上のセルが崩れたり...」
>のほうはちょっと分かりません。
>
>実行時エラー（アプリケーション定義またはオブジェクト定義エラー）
>のほうは、こういうことではありませんか
>たとえば、30行目〜60行目までを選択すると、選択された行数は
>31行です。（RowCnt = 31）
>そのOffset(-RowCount) は何行目ですか？

60行目の31行上だから29行目、ということになるのでしょうか？

このエラーを回避するにはどうしたらいいのでしょうか？
【70198】Re:上の行を書式のみをコピーして、選択...
発言  kanabun  - 11/10/19(水) 11:21 -
引用なし
パスワード
   ▼げっち さん：

>>たとえば、30行目〜60行目までを選択すると、選択された行数は
>>31行です。（RowCnt = 31）
>>そのOffset(-RowCount) は何行目ですか？
>
>60行目の31行上だから29行目、ということになるのでしょうか？

いえ、「30行目〜60行目までを選択」したとき Rows("30:60")、
その範囲を 31行上へOffsetしたら、Rows("0:29") です。

>このエラーを回避するにはどうしたらいいのでしょうか？
ちょっとおやりになりたいことの詳細が分かりません。
すみません。
選択行は いつも 現在データが入っている範囲のすぐ下の（現在
未入力の）行ということですか？
それとも、途中の行に（複数行）挿入というケースもありですか？
【70200】Re:上の行を書式のみをコピーして、選択...
発言  げっち  - 11/10/19(水) 12:23 -
引用なし
パスワード
   ▼kanabun さん：

返答ありがとうございます。

>
>>このエラーを回避するにはどうしたらいいのでしょうか？
>ちょっとおやりになりたいことの詳細が分かりません。
>すみません。
>選択行は いつも 現在データが入っている範囲のすぐ下の（現在
>未入力の）行ということですか？
>それとも、途中の行に（複数行）挿入というケースもありですか？

途中の行に挿入というケースも有りえます。
【70202】Re:上の行を書式のみをコピーして、選択...
発言  SS  - 11/10/19(水) 13:55 -
引用なし
パスワード
   ▼げっち さん：
横から失礼します。
やりたいことは、こんな感じですか？
Sub Macro2()
　　Dim R As Long, C As Long
　　Dim Cn As Integer
　　
　　R = Selection.Row
　　C = Selection.Column
　　Cn = Selection.Columns.Count
　　
　　Selection.Insert Shift:=xlDown
　　Range(Cells(R - 1, C), Cells(R - 1, C + Cn - 1)).Copy
　　Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=False
End Sub

>▼kanabun さん：
>
>返答ありがとうございます。
>
>>
>>>このエラーを回避するにはどうしたらいいのでしょうか？
>>ちょっとおやりになりたいことの詳細が分かりません。
>>すみません。
>>選択行は いつも 現在データが入っている範囲のすぐ下の（現在
>>未入力の）行ということですか？
>>それとも、途中の行に（複数行）挿入というケースもありですか？
>
>途中の行に挿入というケースも有りえます。
【70204】Re:上の行を書式のみをコピーして、選択...
発言  kanabun  - 11/10/19(水) 15:12 -
引用なし
パスワード
   ▼げっち さん：
>
>途中の行に挿入というケースも有りえます。

途中に、行挿入すると、それらの書式は以前の書式がそのまま残っています。
なので、すでに書式が設定してある途中の行に 行挿入するばあいは 書式の
Copyはわざわざする必要がないってことになりませんか？

Sub Try1()
　　Dim r As Range
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　Set r = Selection
　　If r.Columns.Count <> Application.Columns.Count Then
　　　　Set r = Selection.EntireRow
　　End If
　　
　　r.Insert
　　
End Sub

データ行の下の現在書式がセットされていない行を選択して
1行上の書式だけをそれらの選択行にCopyすることがあるなら、
Sub try2()
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　If Selection.Columns.Count <> Application.Columns.Count Then
　　　　Selection.EntireRow.Select
　　End If
　　
　　Selection.Insert
　　Selection.Offset(-1).Resize(1).Copy '選択行の一行上をCopy
　　Selection.PasteSpecial xlPasteFormats '選択行全体に 書式貼り付け
End Sub

とかで、ってことかな？
【70209】Re:上の行を書式のみをコピーして、選択...
お礼  げっち  - 11/10/19(水) 19:22 -
引用なし
パスワード
   ▼SS さん：

>横から失礼します。
>やりたいことは、こんな感じですか？
>Sub Macro2()
>　　Dim R As Long, C As Long
>　　Dim Cn As Integer
>　　
>　　R = Selection.Row
>　　C = Selection.Column
>　　Cn = Selection.Columns.Count
>　　
>　　Selection.Insert Shift:=xlDown
>　　Range(Cells(R - 1, C), Cells(R - 1, C + Cn - 1)).Copy
>　　Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
>　　　　SkipBlanks:=False, Transpose:=False
>End Sub
>

まさしくこれがやりたかったことです。
特にエラーも起きずに実行できました。ありがとうございます。

kanabun さんも回答ありがとうございました。
今後の参考にさせて頂きます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2072 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free