• ベストアンサー

Excel95とExcel2000でのマクロでの動作違いについて

下記のマクロをExcel95とExcel2000で動かすと結果(フォーマット)が違ってきます。 何処をどの様に修正すれば良いか教えてもらえないでしょうか。 言語の意味も出来たら教えてもらえますか。よろしくお願いします。 尚、省略している所があります。(言語は800文字以上は遅れませんので) Sheets("印刷").Select Dim gyo, cout, st, a, burank, st2, burank2 Dim total As Integer Dim tt As String cout = 1 Range("a3").Select total = 2 Do total = total + 1 burank = Worksheets("印刷").Cells(total, 25).Text Loop While burank <> "" total = total - 2 For a = 3 To total If a = 3 Then Range(Cells(a, 3), Cells(a, 26)).Select With Selection.Borders(xlBottom) .Weight = xlHairline End With Else ' burank1 = Worksheets("印刷").Cells(a + 1, 2).Text st = Worksheets("印刷").Cells(a, 1).Text If st = "" And burank1 <> "" Then ' Range(Cells(a, 2), Cells(a, 2)).Select ActiveCell.Formula = "小 計" ' With Selection .HorizontalAlignment = xlCenter End With gyo = a + 1 Range(Cells(a, 1), Cells(a, 26)).Select With Selection.Borders(xlLeft) .Weight = xlThin ' End With

noname#72697
noname#72697

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

  • ベストアンサー
  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.3

修正漏れが1箇所?関係ないかもしれませんが追記しておきました。   ○選択したセル範囲の下罫線を中太線(表現が正しい?)にしている。   With Selection.Borders(xlEdgeBottom)     .Weight = xlMedium   End With   ○その行のC、D列を選択して左罫線をなしにしている   Range(Cells(a, 3), Cells(a, 4)).Select   Selection.Borders(xlEdgeLeft).LineStyle = xlNone   ○その行の26番目の列を選択して算式を登録している     算式は、その行の12個左の列が正の数値で、         1つ左のセルが0超、0.9未満なら『●』を表示する   Range(Cells(a, 26), Cells(a, 26)).Select   ActiveCell.FormulaR1C1 = _      "=IF(RC[-12]>0,IF(AND(RC[-1]>0,RC[-1]<0.9),""●"",""""),"""")"   Else   ○1行下が未入力の場合   If burank1 = "" Then     ○1行下のA列から26列分選択して左罫線を細線にしている     Range(Cells(a + 1, 1), Cells(a + 1, 26)).Select     With Selection.Borders(xlEdgeLeft)       .Weight = xlThin     End With     ○下罫線を中太線にしている     With Selection.Borders(xlEdgeBottom)       .Weight = xlMedium     End With     ○1行下のC、D列を選択して左罫線をなしにしている。<<xlLeft⇒xlEdgeLeft>>     Range(Cells(a + 1, 3), Cells(a + 1, 4)).Select     Selection.Borders(xlLeft).LineStyle = xlNone     ○その行のB列を選択して『小 計』の文字をセット     Range(Cells(a, 2), Cells(a, 2)).Select     ActiveCell.Formula = "小 計"     ○セットした文字をセルの中央に配置している。     With Selection       .HorizontalAlignment = xlHAlignCenter     End With     ○その行のA列から26列分を選択     Range(Cells(a, 1), Cells(a, 26)).Select     ○選択したセル範囲の左罫線を細線にしている。     With Selection.Borders(xlEdgeLeft)       .Weight = xlThin     End With     ○選択したセル範囲の下罫線を中太線にしている。     With Selection.Borders(xlEdgeBottom)       .Weight = xlMedium     End With     ○その行C、D列を選択して左罫線をなしにしている     Range(Cells(a, 3), Cells(a, 4)).Select     Selection.Borders(xlEdgeLeft).LineStyle = xlNone     ○その行の26番目の列を選択して算式を登録している。算式は同じ     Range(Cells(a, 26), Cells(a, 26)).Select     ActiveCell.FormulaR1C1 = "=IF(RC[-12]>0,IF(AND(RC[-1]>=0,RC[-1]<0.9),""●"",""""),"""")"     ○Forループの中でそれを制御する変数aを操作している。恐い!。      本来やってはいけないはず!別の方法があるはず。     a = a + 2   Else     If a = gyo Then       Range(Cells(a, 3), Cells(a, 26)).Select       ○下罫線を細線にしている。       With Selection.Borders(xlEdgeBottom)         .Weight = xlHairline       End With     Else       Range(Cells(a, 1), Cells(a, 2)).Select       Selection.ClearContents       Range(Cells(a, 26), Cells(a, 26)).Select       ○算式をセットしている         算式は、その行の12個左の列が正の数値で、          1つ左のセルが0.5以上、0.9以下なら『☆』を表示する          1つ左のセルが0.5未満なら『★』を表示する       ActiveCell.FormulaR1C1 = "=IF(RC[-12]>0,IF(AND(RC[-1]>=0.5,RC[-1]<=0.9),""☆"",IF(AND(RC[-1]>=0,RC[-1]<0.5),""★"","""")),"""")"     End If   End If   'アンダーライン(3:26)   Range(Cells(a, 3), Cells(a, 26)).Select   With Selection.Borders(xlEdgeBottom)   ○下罫線を細線にしている。     .Weight = xlHairline   End With End If End If 'アンダーライン(3:26) Next a ○トータル行を選択 Range(Cells(total + 1, 1), Cells(total + 1, 26)).Select With Selection.Borders(xlEdgeLeft)   ○選択したセル範囲の左罫線を細線にしている。   .Weight = xlThin End With With Selection.Borders(xlEdgeBottom)   ○選択したセル範囲の下罫線を中太線にしている。   .Weight = xlMedium End With ○その行C、D列を選択して左罫線をなしにしている Range(Cells(total + 1, 3), Cells(total + 1, 4)).Select Selection.Borders(xlEdgeLeft).LineStyle = xlNone ○セルY3を選択して算式をセット   算式は、N3がゼロでなかったらX3をN3で割って、小数1位で四捨五入 Range("Y3").Select ActiveCell.Formula = "=IF(n3=0,0,ROUND(x3/n3,1))" Range("Y3").Select Selection.Copy ○Y3の算式をデータの25列目にコピーしている Range(Cells(4, 25), Cells(total + 1, 25)).Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ○再計算している ActiveSheet.Calculate Range("a1").Select ※aでLoopしているForループの途中に『a = a + 2』がありますが問題なく動いてるんですよね。  全体を通して行っていることは、不定行の小計を計算して、それを罫線付の印刷で行おうとしているように思えます。  印刷用のシートにページ単位でデータをはきだし、小計行の罫線パターンを別に用意しておいて書式をコピーすれば簡単になりそうですね。  表示書式や割算の算式も事前に作っておけばマクロの中で定義する必要がなくなるわけです。

その他の回答 (2)

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.2

コードの意味は『○』を付けた箇所に書いてみました。 修正箇所としては、<<  ⇒  >> とした3箇所を修正してみてください。 実際、動かすことができないので見ただけの産物です。うまくいけばいいですが。 ○シート印刷を選択 Sheets("印刷").Select ○配列の宣言。チャンと宣言したほうがいいか Dim gyo, cout, st, a, burank, st2, burank2 Dim total As Integer Dim tt As String cout = 1 ○A3を選択。多分、表の左上でしょう Range("a3").Select total = 2 ○3行目から、データが入力された行数をカウントしている Do  total = total + 1  burank = Worksheets("印刷").Cells(total, 25).Text Loop While burank <> "" ○行数を余分に数えたので引いているが、これでは最終行-1の行数か。 total = total - 2 ○3行目から最終行-1まで繰り返す For a = 3 To total  ○最初の行なら  If a = 3 Then   ○3行目でA列から26列分を選択している。多分、表題か   Range(Cells(a, 3), Cells(a, 26)).Select   ○選択した範囲の下罫線を極細にしている。<<xlBottom⇒xlEdgeBottom>>   With Selection.Borders(xlBottom)    .Weight = xlHairline   End With  Else ○4行目から、その行のA列と次の行のB列の入力具合を調べている  burank1 = Worksheets("印刷").Cells(a + 1, 2).Text  st = Worksheets("印刷").Cells(a, 1).Text  ○その行のA列が未入力で次の行のB列に入力があった場合、以下の処理をする  If st = "" And burank1 <> "" Then   ○その行のB列を選択して『小 計』の文字をセット   Range(Cells(a, 2), Cells(a, 2)).Select   ActiveCell.Formula = "小 計"   With Selection    ○セットした文字をセルの中央に配置している。<<xlCenter⇒xlHAlignCenter>>    .HorizontalAlignment = xlCenter   End With   ○変数gyoに+1   gyo = a + 1   ○その行のA列から26列分を選択。多分、データ行   Range(Cells(a, 1), Cells(a, 26)).Select   ○選択したセル範囲の左罫線を細線にしている。<<xlLeft⇒xlEdgeLeft>>   With Selection.Borders(xlLeft)    .Weight = xlThin   End With

noname#72697
質問者

お礼

理解していきたいと思います。ありがとうございました。

noname#72697
質問者

補足

回答ありがとうございました。実は下記のコードの続きがあります。 良ければ意味を教えてください。 よろしくお願いします。 With Selection.Borders(xlEdgeBottom) .Weight = xlMedium End With Range(Cells(a, 3), Cells(a, 4)).Select Selection.Borders(xlEdgeLeft).LineStyle = xlNone Range(Cells(a, 26), Cells(a, 26)).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-12]>0,IF(AND(RC[-1]>0,RC[-1]<0.9),""●"",""""),"""")" Else If burank1 = "" Then Range(Cells(a + 1, 1), Cells(a + 1, 26)).Select With Selection.Borders(xlEdgeLeft) .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .Weight = xlMedium End With Range(Cells(a + 1, 3), Cells(a + 1, 4)).Select Selection.Borders(xlLeft).LineStyle = xlNone Range(Cells(a, 2), Cells(a, 2)).Select ActiveCell.Formula = "小 計" With Selection .HorizontalAlignment = xlHAlignCenter End With Range(Cells(a, 1), Cells(a, 26)).Select With Selection.Borders(xlEdgeLeft) .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .Weight = xlMedium End With Range(Cells(a, 3), Cells(a, 4)).Select Selection.Borders(xlEdgeLeft).LineStyle = xlNone Range(Cells(a, 26), Cells(a, 26)).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-12]>0,IF(AND(RC[-1]>=0,RC[-1]<0.9),""●"",""""),"""")" a = a + 2 Else If a = gyo Then Range(Cells(a, 3), Cells(a, 26)).Select With Selection.Borders(xlEdgeBottom) .Weight = xlHairline End With Else ' Range(Cells(a, 1), Cells(a, 2)).Select Selection.ClearContents Range(Cells(a, 26), Cells(a, 26)).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-12]>0,IF(AND(RC[-1]>=0.5,RC[-1]<=0.9),""☆"",IF(AND(RC[-1]>=0,RC[-1]<0.5),""★"","""")),"""")" End If End If 'アンダーライン(3:26) Range(Cells(a, 3), Cells(a, 26)).Select With Selection.Borders(xlEdgeBottom) .Weight = xlHairline End With End If End If 'アンダーライン(3:26) Next a Range(Cells(total + 1, 1), Cells(total + 1, 26)).Select With Selection.Borders(xlEdgeLeft) .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .Weight = xlMedium End With Range(Cells(total + 1, 3), Cells(total + 1, 4)).Select Selection.Borders(xlEdgeLeft).LineStyle = xlNone Range("Y3").Select ActiveCell.Formula = "=IF(n3=0,0,ROUND(x3/n3,1))" Range("Y3").Select Selection.Copy Range(Cells(4, 25), Cells(total + 1, 25)).Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Calculate Range("a1").Select

  • SpeedKing
  • ベストアンサー率50% (6/12)
回答No.1

>結果(フォーマット)が違ってきます どのように違うかはEXCEL95を使用していないため、記憶に頼っていますが、罫線の設定で定数や実行結果に変更があったように思います(97の時?)。 EXCEL95の定数 xlLeft、xlBottom は、変更されて以下のようになっています。 xlEdgeLeft、xlEdgeBottom  (xlBordersIndexのメンバです) この当たりの関係では?

関連するQ&A

  • EXCELマクロについて

    条件 シート名提供データE列の3行目からデータが入っています。    ブランク以外のデータをコピーしてシート名WorkのC列の2行目から貼り付けたいので下記のマクロを書いていますがおかしい所 はないのでしょうか。教えてください。 いまいちCellsの使い方がわかりません。 出来たら下記の意味を教えてください。 brank = Worksheets("提供データ").Cells(gyo, 5).Text Range(Cells(3, 5), Cells(gyo, 5)).Select Sub 貼付() Dim gyo, brank Sheets("提供データ").Select Range("e3").Select gyo = 2 Do gyo = gyo + 1 brank = Worksheets("提供データ").Cells(gyo, 5).Text Loop While brank <> "" Range(Cells(3, 5), Cells(gyo, 5)).Select Selection.Copy Sheets("work").Select Range("c2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • EXCEL2000で作成したマクロが2007で動作しない

    EXCEL2000で作成したマクロがEXCEL2007上で動作しません。 2つのシートに入ったデータを,「抽出」シートにコピー後, 抽出条件に合わせて抽出するというものなのですが, 「Sheet1」で最終行を取得するところで,正しい範囲を 選択しません。どこが間違えているのか,ご指南頂けないでしょうか? お願いいたします。 下には,正しい結果が出ない所までを貼りつけました。 Sub フィルタオプション() Dim LastRow As Long, LastColumn As Long Dim myData As Range Dim myCriteria As Range Sheets("Sheet1").Select Rows("1:1").Select Selection.Copy Sheets("抽出").Select Rows("3:3").Select ActiveSheet.Paste If Worksheets("Sheet1").FilterMode = True Then   Worksheets("Sheet1").ShowAllData End If With Worksheets("Sheet1") LastRow = .Cells(Application.Rows.Count, "A").End(xlUp).Row End With Sheets("Sheet1").Select Range(Rows(2), Rows(LastRow)).Select Selection.Copy Range("A1").Select Sheets("抽出").Select Range(Rows(4), Rows(4)).Select Selection.Insert Shift:=xlDown

  • 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

  • excelマクロについて

    下記のマクロを実行したときに、Sheets("提供データ")のD列の7327行目はブランクなのに、Sheets("jyoken")のa列の7326行目に計算式がコーピされるのはなぜでしょうか。 ちなみにSheets("jyoken")のa列の2行目に=提供データ!D3という計算式 が入っています。 Sheets("jyoken")のa列の7326行目には計算式がコーピしないようにするにはどこを修正すればよいのでしょうか教えてください。 Sub 式複写() Dim gyo, burank ActiveWorkbook.PrecisionAsDisplayed = False Sheets("提供データ").Select Range("a2").Select gyo = 2 burank = "" Do gyo = gyo + 1 burank = Worksheets("提供データ").Cells(gyo, 4).Text Loop While burank <> "" ' Sheets("jyoken").Select Range("A2").Select Selection.Copy Range(Cells(3, 1), Cells(gyo - 1, 1)).Select '複写先 ActiveSheet.Paste End Sub

  • vb6.0でEXCELオブジェクトの使用

    以下のプログラムで四苦八苦しております。 vb6.0だとエラーが出て、vbaだとエラーはなく正常に終了します。 (エクセルは2002です) ※vbは、「microsoft excel 10.0 object library」にチェックを 入れています。 vb6.0だと「w_range.Select」の下の行の 「With Selection.Borders(xlEdgeLeft)」で 「実行時エラー424 オブジェクトが必要です。」となります。 後、「microsoft excel 10.0 object library」にチェックを入れる 事によって、vbaで作成できるプロバティ・メッソド等は使用できる と考えていいのでしょうか? ************** Private Sub Form_Load() Dim xls_csv As Object Dim w_range As Object Set xls_csv = CreateObject("Excel.Sheet") Set xls_kei = CreateObject("Excel.Sheet") xls_csv.Sheets(1).Name = "test" xls_csv.Application.Visible = True With xls_csv.Worksheets(1) .Cells(1, 2).Value = "aaa" .Cells(1, 3).Value = "bbb" .Cells(1, 4).Value = "ccc" End With With xls_csv.Worksheets(1) Set w_range = .Range(.Cells(1, 2), .Cells(10, 4)) End With w_range.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 End Sub **************

  • エクセルのVBAの記述について

    VBAの記述についてなのですが、 Sub filter() Dim gyo As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = Worksheets("データ") Set ws2 = Worksheets("チーム") Application.ScreenUpdating = False ws2.Range("A4:BH30").Clear gyo = ws1.Range("A65536").End(xlUp).Row ws1.Activate With ws1.Range(Cells(4, 1), Cells(gyo, 6)) .AutoFilter Field:=1, Criteria1:="A" .SpecialCells(xlCellTypeVisible).Copy ws2.Range("A4") Selection.AutoFilter End With Application.ScreenUpdating = True End Sub ならプログラムははしるのですが、 14行目を .SpecialCells(xlCellTypeVisible).Copy ws2.Range(Cells(4, 1)) だと 「実行時エラー 1004 Rangeメソッドは失敗しました Worksheet オブジェクト」 とでるのですが、出来ないのでしょうか? Cells(4, 1)の1のところを変数にして変えていきたいのですが、よい方法はありますか。 よろしくお願いいたします。

  • マクロの意味について

    下記の様なマクロがあります。意味が理解できていません。 教えてもらえないでしょうか。 Windows("aaa.XLS").Activate Dim tbl, gyo, burank Range("i4").Select Set tbl = ActiveCell.CurrentRegion tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select Stop Selection.Copy Windows("bbb.XLS").Activate Sheets("ccc").Select Range("B2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A2").Select Application.CutCopyMode = False ActiveCell.Formula = "=B2&C2&D2" Range("A2").Select Selection.Copy gyo = 0 Do gyo = gyo + 1 burank = Worksheets("ccc").Cells(gyo, 2).Text Loop While burank <> "" Range(Cells(3, 1), Cells(gyo - 1, 1)).Select    ActiveSheet.Paste Application.CutCopyMode = False Range("A2").Select

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

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

    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は慣れている人から見ると何点くらいですか?(感覚で結構です)

  • エクセル・マクロ CSVファイルの読込方法と改行

    マクロがうまく作成出来ずにいます。 是非、教えて頂けないでしょうか、宜しくお願い致します。 マクロでやりたい事は二つあります。 (1)あるシステムよりRドライブ内にデータを落とし、その後エクセルシートへ貼り付ける作業を行っているのですが、この作業をマクロで出来るようにしたいです。 ただ、データを落とした段階では拡張子表示にしても何もついていないデータになっていますが、中身からしておそらくCSV形式のデータだと思います。 (2)シート(1)、(2)、(3)にあるデータをシート(4)に順番に貼り付けていきたいのですが、(1)のシートのデータと(2)の間に空白の行を一行、(2)と(3)の間にも空白の行を一行としていきたいのです。 (2)に関しては途中までマクロを書いたのですが、エラーが出てうまくいきません。 作成したマクロは以下です。 Sheets("summary").Activate Range("A3").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.ClearContents 'AUD シート Sheets("AUD").Activate ActiveSheet.Range("A1").Select ActiveSheet.Range("A1:P1").Select ActiveSheet.Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("summary").Activate ActiveSheet.Range("A3").Select ActiveSheet.Paste 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 Application.CutCopyMode = False ActiveCell.Select ActiveSheet.Range(Selection.End(xlDown)).Select Cells.Replace What:=Chr(10), Replacement:="<br>" 最後の数行でエラーが出ます。 マクロの初心者でこんな事もわからないのかと思われるかもしれませんが、 どうぞ宜しくお願い致します。

専門家に質問してみよう