こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

結合セル解除

補足情報の追加書き込みがわかりませんので何度もトビを起こしいます。
申し訳ございません。

↓例で、
G列結合セルを解除して、解除した行にすべてに"●"と入れたいのですがコピーできません。。
ご意見をいただけませんか?
------------

Option Explicit

Sub Sample()
Dim nRow, i, Addr, tmp

Worksheets("Sheet1").Range("D:E,K:K,V:Y,AF:AM").Copy
With Worksheets("sheet2")
'Y列も"sheet2"にコピー(G列)
.Range("A1").PasteSpecial Paste:=xlPasteValues
nRow = .Cells(Rows.Count, 1).End(xlUp).Row 'データのある最終行
For i = 5 To nRow
If .Cells(i, 2) = "" Then .Cells(i, 2) = .Cells(i - 1, 2) 'B列
If .Cells(i, 4) = "" Then .Cells(i, 4) = .Cells(i - 1, 4) 'D列
Next i

'Y列("sheet2"のG列)のデータ分行を追加
For i = nRow To 4 Step -1
'Y列("sheet2"のG列)にデータがあるか
If .Cells(i, 7) <> "" Then
tmp = .Cells(i, 7)

'-------------ここがうまくいきません。
'G列結合セルを解除して対象行にすべて「OK」と入れる。
If .Cells(i, 7).MergeCells Then
Addr = .Cells(i, 7).MergeArea.Address
.Cells(i, 7).UnMerge
.Range(Addr) = "●"
End If
'------------ここがうまくいきません。

.Rows(i).Copy
.Rows(i).Insert
.Cells(i + 1, 3) = "-"
.Cells(i + 1, 6) = tmp
'.Cells(i, 7) = "●"
.Cells(i + 1, 7) = "★"
End If
Next i

'Y列("sheet2"のG列)の最後尾列(Q列)への移動
.Columns(7).Cut
.Columns(17).Insert
End With

End Sub

投稿日時 - 2013-07-05 15:02:58

QNo.8163435

すぐに回答ほしいです

質問者が選んだベストアンサー

.Range("A1").PasteSpecial Paste:=xlPasteValues
ですが、セルの結合状態が貼り付けられないのではないでしょうか。
とりあえず下記の1行を追加してもう一度試してみてはいかがでしょうか。
.Range("A1").PasteSpecial Paste:=xlPasteFormats

投稿日時 - 2013-07-05 20:58:19

補足

ありがとうございます。

↓のようにして、
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A1").PasteSpecial Paste:=xlPasteFormats
セルの解除ができました。
解除した複数行にすべて"●"がコピーされました。

しかし、問題がございます。
セル解除の対象はG列です。
ご意見をいただけないでしょうか?

1.
行の追加処理が先頭行に"●"をコピーした直下に行われます。
解除した最終行の直下に行の追加処理をしたいです。

2.
実行終了までにパフォーマンスが悪くなります。時間もかかり、CPU使用率が100%で他の処理ができなくなります。

投稿日時 - 2013-07-08 00:29:44

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問