- ベストアンサー
EXCEL VBA 早く処理をする方法と構文の簡素化
kagakusukiの回答
LastRowの値を求める際に、 LastRow = .Range("A150").End(xlUp).Row + 1 とA150を基点にしている事や、行番号を+1にしている事は何故なのか意味が解りません。 全て一律に LastRow = .Range("A" & Rows.Count).End(xlUp).Row で処理してしまえば良いのではないでしょうか? 処理に時間がかかる原因は、計算方法のモードが自動モードになっているため、VBAでセルの値を入力したり、書き換えたりするたびに再計算が行われるためですから、VBAのマクロ上で計算方法のモードを一旦、手動モードに切り替えてから値の書き換えを行う様にされると良いと思います。 Sub QNo9129440_EXCEL_VBA_早く処理をする() Dim i As longe, LastRow As Long With Application .ScreenUpdating = False .Calculation = xlManual End With For i = 1 To 12 With Worksheets(i) LastRow = .Range("A" & Rows.Count).End(xlUp).row .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Range("G8:G" & LastRow).FormulaR1C1 = "=R[-1]C+RC5-RC6" With .Range("A" & LastRow) .Offset(1, 4).Resize(3, 3).ClearContents .Offset(1, 3) = .Parent.Name & "合計" .Offset(2, 3) = "前月繰越" .Offset(3, 3) = "次月繰越" .Offset(4, 3) = "合計" .Offset(1, 4).Resize(1, 2).FormulaR1C1 = "=SUM(R7C:R[-1]C)" .Offset(2, 4) = .Range("G7") .Offset(4, 5) = .Offset(2, 4) .Offset(4, 4) = .Offset(2, 4) + .Offset(1, 4) .Offset(3, 5) = .Offset(4, 4) - .Offset(1, 5) .Offset(4, 6) = .Offset(0, 6) End With With .Range("C7").End(xlDown).Offset(0, 2).Resize(1, 3) .Borders(xlEdgeTop).Weight = xlHairline With .Borders(xlEdgeBottom) .Weight = xlThin .LineStyle = xlContinuous End With With .Offset(4) .Borders(xlEdgeTop).Weight = xlHairline .Borders(xlEdgeBottom).LineStyle = xlDouble End With End With End With Next i With Application .Calculation = xlAutomatic .ScreenUpdating = True End With End Sub
関連するQ&A
- このマクロコードをダイエットするには?
罫線を引き、配色し、文字に色を付ける。 このコードをどのようにダイエットすればよいのでしょうか? 罫線のマクロはこんなに大きいのですか? 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
- ベストアンサー
- オフィス系ソフト
- Excel VBAで罫線を引くマクロを書きたい
Excel VBAで罫線を引くマクロを書きたいと思っています。 で、文末のコードを書きました。(というかマクロ記録したものほぼそのもの) これだとある程度動くのですが、内側線が無いような範囲を選択した場合にはエラーになってしまいます。 内側の線を引く際にIF文をかまさなければならないように思うのですが、イマイチわかりません。 この点について教えてください。 また、コードが冗長であるようにも思えます。もう少しスマートな書き方があればあわせて教えてください。 よろしくお願いします。 Sub 枠線基本() ' 周囲 With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .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 End Sub
- ベストアンサー
- オフィス系ソフト
- VBA 「文字が入っていたら、上下に線を引く」
困っています。どなたか教えてください。 下記のように作成しましたが、 A列に文字が入っていたら、上下に線を引くというプロシージャにしたいと思っています。 If Cells(c, 4) = "" Then Range(Cells(c, 1), Cells(c, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With bolFlg = True Else まだまだ続きますが・・・・。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで罫線挿入
マクロの記録で下記のように記録されたものを簡潔にまとめるにはどのように記述したらいいでしょうか? Range("C3:F3").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 .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom End With
- ベストアンサー
- オフィス系ソフト
- VBAで表作成
こんにちわ VBAを使い表を作っているのですが、入力フォームで日付を入力しコマンドボタンを押すと別ブックになり、予め用意してある表に入力した日付から1ヶ月の日付が貼り付けるというのをやっています。 マクロを記録し試してみたところ構文エラーが出てしまいました。 日付を貼り付けるところまでできたのですが・・・ 表には線がすでに入っています。 入力された最後の日付のところで太線で表を閉めたいのですができますでしょうか。 構文エラーになったソースを貼り付けます。 Range((4,"i"+12):(10,"i"+12)).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 = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With よろしくお願いします
- 締切済み
- その他(プログラミング・開発)
- EXCEL VBAでHPageBreaks
いつもお世話様です。 こちらで教えていただいたマクロでフッダーの前に自動で罫線を引こうとしています。 前の質問は→http://okweb.jp/kotaeru.php3?q=1310420 下記のマクロを動かすと、1ページだけの時はちゃんとフッダーの上に罫線が引けますが、2ページ目になると「インデックスが有効範囲にありません」という実行時エラーが出てしまいます。 どこがいけないのでしょうか? Sub 自動罫線TEST() Dim BreakSu As Integer Dim BreakSu2 As Integer Dim B As Integer Dim Rw As Long Dim LastRow As Long For N = 1 To 3 With Cells .ClearContents .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Range("A1:D" & N * 30) = N & N & N 'TESTデータ挿入 LastRow = Range("A65536").End(xlUp).Row '最終行取得 BreakSu = ActiveSheet.HPageBreaks.Count '改ページ数取得 Range(Cells(LastRow + 1, "A"), Cells(LastRow + 100, "A")) = "ABC" '改ページ数を増やすダミー BreakSu2 = ActiveSheet.HPageBreaks.Count '増えた改ページ数取得 For B = 1 To BreakSu + 1 ' MsgBox B & "-" & BreakSu + 1 & "-" & BreakSu2 Rw = ActiveSheet.HPageBreaks(B).Location.Row - 1 '改ページ前行取得(ここでエラー!) With Range(Cells(Rw, "A"), Cells(Rw, "D")).Borders(xlEdgeBottom) '改ページ前罫線挿入 .LineStyle = xlContinuous End With Next B Range(Cells(LastRow + 1, "A"), Cells(LastRow + 100, "A")) = ClearContents 'ダミー消去 ActiveSheet.PrintPreview Next End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ VBA 罫線 文字列
職場で使う表をVBAマクロを用いて罫線作成をしています。 前任者のアレンジを頼まれたのですが前任者に連絡が取れず困っています。 表の特徴は以下のようになります。 ・A列を飛ばし、B列から2列飛びで文字を記入 ・b2=曜日、b3=1、b4=2、b5=3、b6=4、b7=空白のセットが曜日ごとに2セット×7日分 この表を ・b2=曜日、b3=-3、b4=-2、b5=-1、b6=0、b7=1、b8=2、b9=3、b10=4、b11=空白のセットが曜日ごとに2セット×7日分 に変更したいのですが空欄の場所がずれてしまい上手くいきません。 原本のマクロは以下です。 ---------------------------------------------------------------- Sub 罫線作成() Range(Cells(4, 1), Cells(86, 22)).Select 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 ch1 = "月火水木金土日" For i = 4 To 76 Step 12 n1 = (i + 8) \ 12 Range(Cells(i, 1), Cells(i + 10, 22)).Select With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .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 'Cells(i, 1) = Mid(ch1, n1, 1) For i2 = 2 To 20 Step 3 For i3 = i To i + 10 nb1 = (i3 + 8) Mod 12 If nb1 = 0 Or nb1 = 6 Then Cells(i3, i2) = Mid(ch1, n1, 1) If nb1 = 1 Or nb1 = 7 Then Cells(i3, i2) = 1 If nb1 = 2 Or nb1 = 8 Then Cells(i3, i2) = 2 If nb1 = 3 Or nb1 = 9 Then Cells(i3, i2) = 3 If nb1 = 4 Or nb1 = 10 Then Cells(i3, i2) = 4 Next Next Next End Sub ---------------------------------------------------------------- 4行目から142行目まで使用することは分かっているのですが… どうかご助力お願いします。
- ベストアンサー
- オフィス系ソフト
- VBA罫線
VBA罫線 a = 9 With Range(Cells(3, 2), Cells(a, 5)) .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With どこのワークシートかを指定する場合はどうしたらいいのでしょうか?
- ベストアンサー
- その他(プログラミング・開発)
- ワークシートのセルの書式設定の罫線をマクロでひく。
ワークシートのセルの書式設定の罫線をマクロでひく。 下記マクロを実行すると (1)のところでBORDERクラスのlinestyle プロパティを設定できません。がでる対策をおしえてください。 Sub Macro1() ' Dim d As Long Sheets("abc").Select '罫線を引く d = Range("A65536").End(xlUp).Row Range("A1", Cells(d, 1)).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 ‘(1) .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub
- ベストアンサー
- オフィス系ソフト
- 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
- ベストアンサー
- その他MS Office製品
補足
kagakusuki 様 早速のご教示ありがとうございます。 構文中の下記か所でエラーになります ”アプリケーション定義またはオブジェクト定義のエラーです” 恐れ入りますが、是正をお願いできないでしょうか。 どうぞよろしくお願いします。 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal