※ ChatGPTを利用し、要約された質問です(原文:Excel VBAの質問です)
Excel VBAの質問!改善したい点とデバッグの問題
このQ&Aのポイント
Excel VBAの質問について、ForEach~Next文の中の特定の部分を改善したいです。具体的には、同じ処理を3回も書くのが冗長だと感じています。
また、デバッグモードではうまく動作するが、通常の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
お礼
できました! 以前keithinさんに教えていただいた構文を元に自分で追加してやってみたんですが、なかなかうまくいかず困っていたところです。 やはりもっと勉強が必要ですね。 ありがとうございました。