人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセル(2003)VBAでつくるマクロに関する質問です。

選択したセルの罫線以外の書式をクリア(初期設定に戻す)マクロを組みたいのですが、
どうすればいいでしょうか。
ただし、できる限り汎用性をもたせ、かつ高速にしたいのです。
VBA勉強中のため、できるだけ色々な方法を知りたいと思っています。

1つ思いついたのは、xlPasteAllExceptBordersを使う方法。
例えば、空白の可能性の高いセル(A65536など)をコピーして、
xlPasteAllExceptBordersで貼り付ける。

どうぞよろしくお願いします。



参考までに動かなかったマクロです。

sub 書式クリア()
Dim セル As Range

For Each セル In Selection
Selection.Font.Bold.Clear
Selection.Font.Color.Clear
Selection.Font.ColorIndex.Clear
Selection.Font.Size.Clear
Selection.Font.Italic.Clear
Selection.Font.Underline.Clear
Selection.Interior.Color.Clear
Selection.Interior.ColorIndex.Clear
Selection.Interior.Pattern.Clear

Next セル

end sub

「オブジェクトが必要です」と出てきてしまいました。clearメッソッドは、プロパティに対しては実行できないようです。


●質問者: tomokazu
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:AS COLOR NeXT sub VBA
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● SALINGER
●30ポイント

動かなかったマクロをそのまま修正すると

Sub 書式クリア()
 Dim セル As Range
 
 For Each セル In Selection
 セル.Font.Bold = False
 セル.Font.ColorIndex = 0
 セル.Font.Size = 11
 セル.Font.Italic = False
 セル.Font.Underline = False
 セル.Interior.ColorIndex = xlNone
 セル.Interior.Pattern = xlPatternNone
 Next

プロパティに適正な値を代入しないといけないです。


セルA65536をコピーする方法だと

Sub 書式クリア()
 Dim セル As Range
 
 Range("A65536").Copy
 For Each セル In Selection
 セル.PasteSpecial Paste:=xlPasteAllExceptBorders
 Next
End Sub
◎質問者からの返答

早速の返信ありがとうございます。

具体的な値を入れないといけないのですね。。。

ところで、colorが削除され、ColorIndexのみが残っていますが、

ColorIndexとcolorは、どちらか片方だけでいいということなのでしょうか?


2 ● SALINGER
●20ポイント

http://www.big.or.jp/~seto/vbaref/vbaref4.htm

ColorとColorIndexは両方とも色を指定するプロパティ。

ColorIndexは番号で、Colorは16進数でより細かい色指定ができます。


因みに上の例だとまだまだ残る書式があります。例えば

フォント名、表示形式、文字位置、セルの結合、折り返し・・・。

◎質問者からの返答

書式に関わるプロパティって、大量にあるんですね。

そんなに書くと高速という点の実現が難しそうなので、やめておきます。

ありがとうございます。


3 ● n_kusano
●50ポイント ベストアンサー

対象セルを他のシートにコピーしクリアしたのち、コピーしたセルの罫線プロパティを対象セルに設定しなおす方法はどうですか?

対象セルを引数にしています

Public Sub clearCell(targetCell As Range)

 Dim copyCell As Range
 Dim direction As Variant
 
'コピー先を決めます 
 Set copyCell = Worksheets("Sheet2").Range(targetCell.Address)

'XlBordersIndexクラス定数を配列にします
 If targetCell.Cells.Count = 1 Then
 direction = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlEdgeTop)
 Else
 direction = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlInsideHorizontal, xlInsideVertical)
 End If

'コピーしたあとクリアします
 targetCell.Copy copyCell
 targetCell.Clear

'コピーしたセルの罫線プロパティのみ対象セルに代入します
 For i = 0 To UBound(direction)
 With targetCell.Borders(direction(i))
 If Not copyCell.Borders(direction(i)).LineStyle = xlLineStyleNone Then
 .LineStyle = copyCell.Borders(direction(i)).LineStyle
 .Weight = copyCell.Borders(direction(i)).Weight
 .Color = copyCell.Borders(direction(i)).Color
 End If
 End With
 Next i

'コピーしたセルをクリアします
 copyCell.Clear

End Sub

◎質問者からの返答

ありがとうございます。

やはり高速という点では疑問符がつきますが、とても勉強になりました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ