みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

Excel VBAの質問です

いつも識者の皆様にはお世話になっております。
Excel VBAのことで質問させてください。

下記のマクロで質問があります。
改善したい点はForEach~Next文の中の
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("E1").Copy Range("A1,C1")
s.Range("A1") = "ddd"
s.Range("B1") = "eee"
s.Range("C1") = "fff"
の部分です。

(1)s.Range("A:A").Cells.EntireColumn.Insertを3つも書くのはスマートじゃないと思うんですが、何かいい構文はありませんか?
(2)E1セルをコピーしてからC1に"fff"と入力するところまでの部分がデバッグモードでやればうまくいくんですが、普通にVBAを実行するとうまくいきません。
具体的にはA列に色をつけて塗りつぶしていた場合、1枚目のシートはB1セルだけ塗りつぶしがなくなって文字列"eee"が入っており、、A1・C1セルは塗りつぶしはありますが"ddd" "fff"の文字列が入っていません。
2枚目以降のシートはA1:C1までのセルにそれぞれ"ddd" "eee" "fff" が入力されていますが、塗りつぶしがなくなっています。
どこかしら構文がおかしいんだと思いますが、どこが悪いのかご指摘いただけますでしょうか。
上記2点以外にもどこか改善点があれば教えていただきたく思います。
識者の皆様、よろしくお願いいたします。



Sub test()
Dim myPath As String
Dim myFile As String
Dim s As Worksheet

myFile = Application.GetOpenFilename()
If myFile = "False" Then
MsgBox "cancel"
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open myFile
myPath = ActiveWorkbook.Path & "\"
myFile = "bbb_" & ActiveWorkbook.Name

For Each s In ActiveWorkbook.Worksheets
s.AutoFilterMode = False
s.Range("A:A").AutoFilter field:=1, Criteria1:="<>ccc"
s.AutoFilter.Range.Offset(1).EntireRow.Delete shift:=xlShiftUp
s.AutoFilterMode = False
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("A:A").Cells.EntireColumn.Insert
s.Range("E1").Copy Range("A1,C1")
s.Range("A1") = "ddd"
s.Range("B1") = "eee"
s.Range("C1") = "fff"
s.Cells.Font.Name = "Arial"
s.Cells.ColumnWidth = 255
s.Cells.EntireRow.AutoFit
s.Cells.EntireColumn.AutoFit
Next

ActiveWorkbook.SaveAs Filename:=myPath & myFile
ActiveWorkbook.Close False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "DONE"

End Sub

投稿日時 - 2012-08-13 12:16:44

QNo.7641494

すぐに回答ほしいです

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

>(1)
range("A:C").insert shift:=xlshifttoright

>(2)
s.range("E1")copy s.range("A1,C1")
s.range("A1:C1") = array("ddd","eee","fff")

投稿日時 - 2012-08-13 13:19:55

お礼

できました!
以前keithinさんに教えていただいた構文を元に自分で追加してやってみたんですが、なかなかうまくいかず困っていたところです。
やはりもっと勉強が必要ですね。
ありがとうございました。

投稿日時 - 2012-08-13 15:13:26

ANo.1

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

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

回答(1)

あなたにオススメの質問