• ベストアンサー

マクロのコーディング

yanmaaの回答

  • ベストアンサー
  • yanmaa
  • ベストアンサー率45% (207/457)
回答No.1

4回繰り返すので簡単にFor文を使いました。 後はHと言う文字の数値で表した値をAsc文でとってChr文で文字に戻しています。 なお動作確認もしていないので間違ってたらすみません。 a = Asc("H") b = 43 For i = 1 to 4 If Range(chr(a) & "39:" & chr(a+1) & "39").Select <> "" Then If .Cells(b, 5).Value = "" Then Total_Check_Flg = True '色付の範囲の設定 Range("A" & CStr(b) & ":B" & CStr(B)).Select 'セルの色の設定(青) With Selection.Interior .ColorIndex = 41 End With Err_Kazu_4 = Err_Kazu_4 + 1 End If End If a = a + 3 b = b + 1 Next

jiri
質問者

お礼

他の仕事と平行してまして、返事送れました。 ごめんなさい。昨日やったところ、結果、思った通りに動きました。 ありがとうございます。 ところで、for loop文はno.2のdandeさんがおっしゃるように、 ここでいう、変数iをloop文中の処理に使用しなくていいんでしょうか?

関連するQ&A

  • マクロの簡素化

    下記マクロです。 Range("AE6:AE1005").Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone If Range("AD6").Value > 5 Then Range("AE6") = "*" Range("AE6").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD7").Value > 5 Then Range("AE7") = "*" Range("AE7").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD8").Value > 5 Then Range("AE8") = "*" Range("AE8").Select With Selection.Interior .ColorIndex = 3 End With Else End If 中略(セルを一個づつ指定しています) If Range("AD1004").Value > 5 Then Range("AE1004") = "*" Range("AE1004").Select With Selection.Interior .ColorIndex = 3 End With End If If Range("AD1005").Value > 5 Then Range("AE1005") = "*" Range("AE1005").Select With Selection.Interior .ColorIndex = 3 End With Else End If Range("AE3").Select 有るセルを参照しその値が5以上だったら別のセルに*マークとセルに色を付けるマクロですが、一個づつセル指定をしていますが、何とか短く出来ないでしょうか? お分かりになる方宜しくお願い致します。

  • Excel2003枠を作るマクロ

    右側に空白の行を一つつくって枠を作りたいです。 たとえば、G100が一番右下とするとH100まで枠を作りたいのですが、きれいにかくにはどうしたらよいでしょうか? マクロ記録でやると、下のようになるのですが右下が100で有るとは限らないのでその行を定義する必要があると思うのですが、そのあたりがさっぱりわかりません。 よろしくお願いいたします。 Sub Macro1() Selection.End(xlDown).Select Range("H100").Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlToLeft)).Select Range(Selection, Selection.End(xlToLeft)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub

  • マクロ:セルの範囲指定

    エクセルマクロで困っています。 セルの範囲指定をしようとしています。 初心者過ぎて、よくわかりません。 現在のマクロ↓ Sub 済() If ActiveCell.Column = 21 Then Selection.FormatConditions.Delete '条件付き書式削除 With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With '色変え判定セル書き換え ActiveCell.Offset(0, 5).Select ActiveCell.FormulaR1C1 = "77" ActiveCell.Offset(0, -5).Select Else answer = MsgBox("U列を選択して下さい", vbCritical) End If End Sub やりたい事は、下記の通りです。 列Uがアクティブの時にU~ACの行を塗りつぶし。 列は変動します。 今は、やり方がよく分からなかったため オフセットで一つ一つ塗りつぶしてます。 マクロを組みすぎてファイルが重くなって困っています。 回答よろしくお願いいたします。

  • このマクロを高速化させるにはどうすればいいですか?

    VBA初心者で、とりあえず頑張って作ってみました。以下のVBAでの修正点を教えてください。 (英単語の小テスト用につくりました。) Range("C3:E22,H3:J22").Select Selection.Font.ColorIndex = 2 Selection.Interior.ColorIndex = 2 Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone ' ここまでは、共通の動作 Range("A1").Select ActiveCell.FormulaR1C1 = "20" ' 問題数に応じて、数字を変更 Range("C3:E22,H3:J22").Select With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With ' 罫線を引く Range("D3:E22,I3:J22").Select Selection.Font.ColorIndex = 1 ' 文字を黒くする Range("C3:C22,H3:H22").Select Selection.Interior.ColorIndex = 16 ' セルをグレーにする Rows("3:18").Select Selection.RowHeight = 31.5 ' セルの幅を指定 ActiveSheet.PageSetup.PrintArea = "$B$1:$K$25" ' 印刷範囲を指定 Range("U3:U42").Select Selection.ClearContents ' 四線を消去 Range("D3:D4").Select Calculate ' 再計算完了 宜しくお願いします。 また、このVBAは慣れている人から見ると何点くらいですか?(感覚で結構です)

  • 下記マクロの意味を教えてください。

    Sub 済() With Worksheets("管理表") If .AutoFilterMode Then .AutoFilterMode = False End If Range("O7:P7").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="=*済*", Operator:=xlAnd ActiveWindow.SmallScroll Down:=-12 Range("A1").Select End With End Sub よろしくお願い致します。

  • エクセルで繰り返し処理をしたいのですが

    下記のマクロを6行目で展開しています。 これと同じ処理を7行目~36行目めまでさせたいのですが どうやればいいのか教えていただけないでしょうか? sub test() Select Case a Case 2, 3, 4, 5, 6 Range("F6").Select Selection.FormulaR1C1 = _ "=IF(RC[-1]-RC[-2]-0.75-RC[8]-RC[9]<=0,0,RC[-1]-RC[-2]-0.75-RC[8]-RC[9])" Range("H6").Select Selection.FormulaR1C1 = "=IF(-7.75>=RC[9],0,RC[9])" Range("J6").Select Selection.FormulaR1C1 = _ "=IF(IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))<=0,0,IF(RC[-5]<=22,0,(RC[-5]-22-RC[6])))" Range("B6:W6").Select With Selection.Interior .ColorIndex = 2 .Pattern = xlSolid End With Case 0, 1 Range("F6").Select Selection.ClearContents Range("H6").Select Selection.ClearContents Selection.FormulaR1C1 = "=IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))" Range("J6").Select Selection.ClearContents Range("B6:W6").Select With Selection.Interior .ColorIndex = 45 .Pattern = xlSolid End With End select End sub

  • このマクロコードをダイエットするには?

    罫線を引き、配色し、文字に色を付ける。 このコードをどのようにダイエットすればよいのでしょうか? 罫線のマクロはこんなに大きいのですか? Withの使い方がよくわかりません。 よろしくお願い致します。 ------------ Sub Test1() Range("B1:O14").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With Selection.Interior .ColorIndex = 56 .Pattern = xlSolid End With Selection.Font.ColorIndex = 33 End Sub

  • エクセルVBAについて

    エクセルVBA初心者で、勉強中の者です。 添付画像のような時間のグラフのようなものを作りたいと思っています。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:05") Then Worksheets("(2)(2)(2)(2)").Range("I2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With Elseif Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:10") Then Worksheets("(2)(2)(2)(2)").Range("J2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With  ・  ・   ・ End If End Sub 'それから、終了の時間を入れて、開始から終了までの間を塗りつぶす。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 以上のように作成しようと考えていましたが、いざやろうとすると 1行に対してあまりにも膨大な記述をしなくてはならないことに 気がつきました(一月分ともなると恐ろしいです・・・)・・・。 もっと効率的な方法はあるものでしょうか? よろしくお願いいたします。

  • エクセルVBAにおける罫線の色指定について

    エクセルVBAの初心者です。 使用機種はWindows VistaでExcel2007です。 後に示すコードではどうして("B4:H7")までの下罫線と ("C4:H8")までの左罫線が青色にならず、黒色のまま になるのでしょうか?("B4:H7")、("C4:H8")ともに 罫線の色は青色にしたいと思っています。 原因と対処方法をご存知の方ご教示願います。 画像も添付しておりますので、合わせてご参照ください。 Sub 日程表作成() Set WS1 = Worksheets("sheeT1") With WS1 .Range("B3") = "日" .Range("B3").Select End With Selection.AutoFill Destination:=Range("B3:H3") WS1.Range("B3:H3").Select With Selection.Borders(xlLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With Selection.Borders(xlTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With Selection.Borders(xlBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With Selection.Borders(xlRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With '下線を二重線に変える Range("B3:H3").Select Selection.Borders(xlBottom).LineStyle = xlDouble WS1.Range("B3:H8").BorderAround Weight:=xlThick, _ ColorIndex:=5, LineStyle:=xlContinuous WS1.Range("B3:H8").RowHeight = 35 '日程表の中に横線を入れる WS1.Range("B4:H7").Select Selection.Borders(xlBottom).LineStyle = xlContinuous WS1.Range("B3:H8").BorderAround Weight:=xlThick, _ ColorIndex:=5, LineStyle:=xlContinuous '日程表の中に縦線を入れる WS1.Range("C4:H8").Select Selection.Borders(xlLeft).LineStyle = xlContinuous WS1.Range("B3:H8").BorderAround Weight:=xlThick, _ ColorIndex:=5, LineStyle:=xlContinuous '曜日のセルを塗りつぶす With WS1 .Range("B3:B8").Interior.ColorIndex = 38 .Range("C3:G8").Interior.ColorIndex = 19 .Range("H3:H8").Interior.ColorIndex = 19 .Range("B4").Activate End With End Sub

  • 【自作マクロ】いらない部分を削除していただきたい。

    自分で行ってみたマクロですが、長く、見づらいです。 いらない部分を削除していただける方がいましたら、お願いいたします。 作業としては、 /////////////////////////////////// あああ いいい ううう えええ おおお かかか      あかさたなはまやらわん の、「あかさたなはまやらわん」を削除し、セルの結合を解除し、 あああ、いいい など文字のあるセルと下のセルを結合して格子をつける。 /////////////////////////////////// Sub 項目を1行にして摘要を削除する() ' ' 項目を1行にして摘要を削除する Macro ' ' Range("C7:H7").Select ActiveCell.FormulaR1C1 = "" Range("C7:H7").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Selection.UnMerge Range("C6:C7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("D6:D7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("E6:E7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("F6:F7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("G6:G7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("H6:H7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("C6:H7").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End Sub