ExcelマクロVBAサンプル集 | 増殖した条件付き書式を整理統合する | ExcelマクロVBAの実用サンプル、エクセルVBA集と解説



最終更新日:2018-02-13

増殖した条件付き書式を整理統合する


コピペによって条件付き書式は際限なく増加していきます、

あまり増えすぎると、
Excelの動作が遅くなる場合もありますし、
条件や書式を変更したい時にも困ることになります。

このような場合は、条件付き書式を消して再設定するしかなくなります、

これを解決するVBAを考えてみました。



Microsoft サポート

Excel 2007 条件付き書式をコピーした場合、以前より条件付き書式が増加する

こちらのページは結構有名かもしれないので、見たことのある人もいるかもしれません。
2007で変更になった仕様によるとの言い訳は仕方ないとして、
回避策が書かれていますが、

回避策
条件付き書式の増加により動作が遅くなった場合、 以下の手順で条件付き書式を削除後、条件付き書式を再度設定します。
[ホーム] タブの [ルールのクリア]-[シート全体からルールをクリア] を選択します。
同じ条件を設定するセルを適宜選択し、条件付き書式を設定します。


これは回避策ではなく、事後処理(というか事故処理)ですよね。
状況
この動作は仕様です。

言い切りましたね。
その潔さは認めます。
そうです、ソフト作成において最終最後の言葉です。


増殖した条件付き書式の実例と対応



右のスクロールバーを見てもらえれば分かる通り、
こうなってしまっては、手作業での修正は諦めた方が良いでしょう。



全て削除してから再度条件付き書式を設定するか、
1行だけ残して(2行目を残すなら、3行目から最下行まで選択して)、ルールをクリアして、
2行目の条件付き書式の適用範囲を変更します。

これをVBAにするのは簡単です。
自動記録でも十分でしょう、セル範囲くらいを変更すれば使えます。

しかし、
行方向・列方向に飛び飛びの範囲に設定されていたりすると、もうお手上げになります。

ちなみに、条件付き書式が設定されているセルを全て選択するには、
ジャンプ(Ctrl+G)→セル選択



簡単なVBAでの対応

全ての条件付き書式をクリアして再設定
Sub sample1()
  With Worksheets("Sheet1").Range("A1:A10")
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="90%"
    .FormatConditions(1).Interior.Color = vbRed
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="100%"
    .FormatConditions(2).Interior.Color = vbYellow
  End With
End Sub

マクロの自動記録で作成されたVBAを変更すれば簡単に作成できま。
2行目の条件付き書式だけ残しクリア後に、2行目の適用範囲を変更
Sub sample2()
  Dim ws As Worksheet
  Dim fObj As Object
  Dim i As Long
  Set ws = ActiveSheet
  ws.Range("3:1000").FormatConditions.Delete
  For i = ws.Rows(2).FormatConditions.Count To 1 Step -1
    Set fObj = ws.Rows(2).FormatConditions(i)
    fObj.ModifyAppliesToRange fObj.AppliesTo.Resize(999)
  Next
End Sub

For Eachで処理したVBAコードを試して見たところ、
同一セル範囲に同一条件付き書式があるような特殊な場合、
Excelが落ちてしまう事がありました。

このVBAコードであれば問題ないと思いますが、
使う時には、必ずバックアップしてから実行する等の注意をしてください。
VBAの条件付き書式の基本については、
マクロVBA入門:第91回.条件付き書式(FormatCondition)
こちらを参考にしてください。


今回のVBAで条件付き書式を整理統合した結果

この後に掲載してあるVBAであれば、上の画像の条件付き書式が、このように整理統合されます。



1行目は、歯抜けの範囲に同じ条件付き書式が設定されていたようです。
これは、私が実際に使っているExcelですが、行挿入して書式が抜けている行があったという事です。
ここまで統合されれば、設定漏れも分かりますし、手作業で直すも簡単です。

こんなVBAが欲しかったという人が多くいるのではないかとの思いで作成してみました。

私自身が、このVBAによって今後の作業がかなり楽になると思っています。


今回のVBAコードの発想について

この仕様については、私も結構悩まされてきました。
手作業で、幾度となく条件付き書式を再設定してきました。
頻繁に発生するシートの場合は、
先に示したようなVBAで、
条件付き書式を削除して再設定できるようにマクロを用意しておいたりして対処してきました。

常々、この仕様は困ったものだとの思いと、なんとか出来ないものかとの思いは持っていました。

最近も条件付き書式が増加しているシートがあったので、手作業で再設定していて、
「これ、なんとか出来ないかなー、出来ないことないはずだよなー」、と思い立ち、
いろいろ考えてみたのですが、これがかなり難しい。

・何をもって、増殖してしまった条件付き書式と判定するのか
・何をもって、同じ条件付き書式と判定するのか

VBAコードのプログラミング以前に、仕様を決定出来ないのです。
頭を整理して、良く考えてみました。
一番の問題は、

・数式が同じかどうかの判定

適用先:=$A$1:$A$10


適用先:=$A$11:$A$20


この2つの条件付き書式は同じものです。
コピペで作ったものです。

セル範囲の条件付き書式では、多くの数式は相対参照で書かれています。
つまり、コピーで増えた条件付き書式の数式は、コピペ先のセル参照に変更されています。

条件付き書式が設定されているセルと、数式が参照しているセルの位置関係が同じかどうか、
そんな判定をどうやってしたら良いのか・・・
参照しているセルの数に制限はない・・・
文字列操作でセル参照を取り出し相対位置を変更・・・
とても現実的とは思えない・・・

いろいろと考えを巡らしているとき、

〜VBAの神様が下りてきた〜

同じセルにコピペして、その数式が同じなら同じ数式ではないか!

それならば、
それぞれの条件付き書式が設定されている先頭セルに、条件付き書式の数式を入れて、
そのセルをコピペで特定のセルに入れた結果の数式で判定できそうです。

この発想で道が開けました。
後は、VBAコードを書くだけ、やることが決まればVBAを書くのは大した問題ではありません。

実際のVBAコードを書く所要時間としては、
分断されているセル範囲が連続セル範囲なのかの判定や、
複数のセル範囲を1つのセル範囲として再定義する部分のコード作成に時間がかかりました。


以下が、完成したVBAコードになります。

増殖した条件付き書式を整理統合するVBA

Option Explicit

Type tFormat
  AppliesTo As String '適用範囲
  Formula1 As String '数式1
  Formula2 As String '数式2
  NumberFormatLocal As String '表示形式
  FontBold As String '太字
  FontColor As String '文字色
  InteriorColor As String '塗りつぶし色
  '追加判定したいプロパティはこの上に追加
  StartRange As String '範囲先頭
  FormulaLocal1 As String 'Formula1の数式判定用
  FormulaLocal2 As String 'Formula2の数式判定用
End Type

Public Sub UnionFormatConditions(ByVal ws As Worksheet, Optional ByVal NewName As String = "")
  Dim i As Long
  Dim ii As Long
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim fObj As Object
  Dim fAry() As tFormat
  Dim sRange As String
  Dim flg As Boolean
  
  '条件付き書式が無い場合は終了
  If ws.Cells.FormatConditions.Count = 0 Then
    Exit Sub
  End If
   
  'オプションにより元シートをコピー
  If NewName = "" Then
    Set ws1 = ws
  Else
    ws.Copy After:=ws
    Set ws1 = ActiveSheet
    ws1.Name = NewName
  End If
  
  '条件付き書式を構造体配列へ格納
  On Error Resume Next '.Formula2が取得できない場合の対処
  For i = 1 To ws1.Cells.FormatConditions.Count
    ReDim Preserve fAry(i)
    Set fObj = ws1.Cells.FormatConditions(i)
    If TypeName(fObj) = "FormatCondition" Then
      Set fObj = ws1.Cells.FormatConditions(i)
      fAry(i).AppliesTo = fObj.AppliesTo.Address
      fAry(i).Formula1 = fObj.Formula1
      fAry(i).Formula2 = fObj.Formula2
      fAry(i).NumberFormatLocal = fObj.NumberFormatLocal
      fAry(i).FontBold = fObj.Font.Bold
      fAry(i).FontColor = fObj.Font.Color
      fAry(i).InteriorColor = fObj.Interior.Color
      '追加判定したいプロパティはこの上に追加
    End If
  Next
  On Error GoTo 0
  
  '編集用シート挿入
  Set ws2 = Worksheets.Add
  
  '同一条件付き書式の判定
  For i = 1 To UBound(fAry)
    If fAry(i).AppliesTo <> "" Then
      '先頭セルの取得
      sRange = getStartAddress(fAry(i).AppliesTo)
      fAry(i).StartRange = sRange
      
      '念の為、演算の計算式をセルに入れて再取得
      ws2.Range(sRange) = fAry(i).Formula1
      fAry(i).FormulaLocal1 = ws2.Range(sRange).FormulaLocal
      If fAry(i).Formula2 <> "" Then
        ws2.Range(sRange) = fAry(i).Formula2
        fAry(i).FormulaLocal2 = ws2.Range(sRange).FormulaLocal
      End If
      
      '計算式1,2、文字色、塗りつぶしの一致判定
      For ii = 1 To i - 1
        If fAry(ii).AppliesTo <> "" Then
          flg = True
          '計算式1
          ws2.Range(sRange) = fAry(i).Formula1
          ws2.Range(sRange).Copy Destination:=ws2.Range(fAry(ii).StartRange)
          If ws2.Range(fAry(ii).StartRange).FormulaLocal <> fAry(ii).FormulaLocal1 Then
            flg = False
          End If
          '計算式2
          If fAry(i).Formula2 <> "" Then
            ws2.Range(sRange) = fAry(i).Formula2
            ws2.Range(sRange).Copy Destination:=ws2.Range(fAry(ii).StartRange)
            If ws2.Range(fAry(ii).StartRange).FormulaLocal <> fAry(ii).FormulaLocal2 Then
              flg = False
            End If
          End If
          '表示形式
          If fAry(i).NumberFormatLocal <> fAry(ii).NumberFormatLocal Then flg = False
          '太字
          If fAry(i).FontBold <> fAry(ii).FontBold Then flg = False
          '文字色
          If fAry(i).FontColor <> fAry(ii).FontColor Then flg = False
          '塗りつぶし
          If fAry(i).InteriorColor <> fAry(ii).InteriorColor Then flg = False
          '追加判定したいプロパティはこの上に追加
          '全てがが一致していれば統合
          If flg = True Then
            fAry(ii).AppliesTo = fAry(ii).AppliesTo & "," & fAry(i).AppliesTo
            fAry(i).AppliesTo = ""
            Exit For
          End If
        End If
      Next
    End If
  Next
  
  '複数セル範囲を統合、デバッグしやすいようにここで
  For i = 1 To UBound(fAry)
    If fAry(i).AppliesTo <> "" Then
      fAry(i).AppliesTo = getUnionAddress(fAry(i).AppliesTo)
    End If
  Next
  
  '条件付き書式の統合
  For i = ws1.Cells.FormatConditions.Count To 1 Step -1
    Set fObj = ws1.Cells.FormatConditions(i)
    If TypeName(fObj) = "FormatCondition" Then
      If fAry(i).AppliesTo = "" Then
        fObj.Delete
      Else
        If fObj.AppliesTo.Address <> ws1.Range(fAry(i).AppliesTo).Address Then
          fObj.ModifyAppliesToRange ws1.Range(fAry(i).AppliesTo)
        End If
      End If
    End If
  Next
  
  '編集用シート削除
  Application.DisplayAlerts = False
  ws2.Delete
  Application.DisplayAlerts = True
End Sub

'複数のセル範囲指定から先頭セルを取得
Private Function getStartAddress(ByVal sAddress As String) As String
  Dim i As Long
  Dim iRow As Long
  Dim iCol As Long
  Dim sSplit() As String
  Dim myRange As Range
  iRow = 9999999
  iCol = 9999999
  sSplit = Split(sAddress, ",")
  For i = 0 To UBound(sSplit)
    Set myRange = Range(sSplit(i))
    If myRange.Row < iRow Or _
      myRange.Column < iCol Then
      iRow = myRange.Row
      iCol = myRange.Column
    End If
  Next
  getStartAddress = Cells(iRow, iCol).Address
End Function

'複数のセル範囲指定から最終セルを取得
Private Function getEndAddress(ByVal sAddress As String) As String
  Dim i As Long
  Dim iRow As Long
  Dim iCol As Long
  Dim sSplit() As String
  Dim myRange As Range
  iRow = 0
  iCol = 0
  sSplit = Split(sAddress, ",")
  For i = 0 To UBound(sSplit)
    Set myRange = Range(sSplit(i))
    Set myRange = myRange.Item(myRange.Count)
    If myRange.Row > iRow Or _
      myRange.Column > iCol Then
      iRow = myRange.Row
      iCol = myRange.Column
    End If
  Next
  getEndAddress = Cells(iRow, iCol).Address
End Function

'2つの範囲が結合されなくなるまで繰り返す
Private Function getUnionAddress(ByVal sAddress As String) As String
  Dim sTemp1 As String
  Dim sTemp2 As String
  sTemp1 = sAddress
  Do
    sTemp2 = getUnionAddress1(sTemp1)
    If sTemp1 = sTemp2 Then
      getUnionAddress = sTemp2
      Exit Function
    End If
    sTemp1 = sTemp2
  Loop
End Function

'2つの範囲を取り出して結合
Private Function getUnionAddress1(ByVal sAddress As String) As String
  Dim i1 As Long
  Dim i2 As Long
  Dim sSplit() As String
  Dim sTemp1 As String
  Dim sTemp2 As String
  
  sSplit = Split(sAddress, ",")
  For i1 = 0 To UBound(sSplit)
    For i2 = i1 + 1 To UBound(sSplit)
      sTemp1 = sSplit(i1) & "," & sSplit(i2)
      sTemp2 = getUnionAddress2(sTemp1)
      If sTemp1 <> sTemp2 Then
        sSplit(i1) = sTemp2
        sSplit(i2) = ""
        getUnionAddress1 = JoinCamma(sSplit)
        Exit Function
      End If
    Next
  Next
  getUnionAddress1 = sAddress
End Function

'セル範囲を結合し最適化
Private Function getUnionAddress2(ByVal sAddress As String) As String
  Dim i1 As Long
  Dim i2 As Long
  Dim sStart As String
  Dim sEnd As String
  Dim sSplit() As String
  Dim myRange As Range
  
  '2つのセルが完全に片方を内包している場合の統合
  sSplit = Split(sAddress, ",")
  For i1 = 0 To UBound(sSplit)
    For i2 = i1 + 1 To UBound(sSplit)
      Set myRange = Intersect(Range(sSplit(i1)), Range(sSplit(i2)))
      If Not myRange Is Nothing Then
        If myRange.Address = Range(sSplit(i1)).Address Then
          sSplit(i1) = ""
        ElseIf myRange.Address = Range(sSplit(i2)).Address Then
          sSplit(i2) = ""
        End If
      End If
    Next
  Next
  sAddress = JoinCamma(sSplit)
  
  '範囲の先頭と最後の範囲のセル数と、元のセル数が同じなら結合
  sStart = getStartAddress(sAddress)
  sEnd = getEndAddress(sAddress)
  
  If Range(sStart, sEnd).Count = Range(sAddress).Count Then
    getUnionAddress2 = Range(sStart, sEnd).Address
  Else
    getUnionAddress2 = sAddress
  End If
End Function

'配列をJOINし不要カンマを削除
Private Function JoinCamma(ByRef sSplit() As String) As String
  JoinCamma = Join(sSplit, ",")
  JoinCamma = Replace(JoinCamma, ",,", ",")
  If Left(JoinCamma, 1) = "," Then
    JoinCamma = Mid(JoinCamma, 2)
  End If
  If Right(JoinCamma, 1) = "," Then
    JoinCamma = Left(JoinCamma, Len(JoinCamma) - 1)
  End If
End Function


下半分くらいは、
セル範囲指定のアドレスをまとめるためのVBAコードになっています。

=$A$11:$A$20,$A$1:$A$10,$A$21:$A$30

=$A$1:$A$30

つまり、条件付き書式の統合だけなら、下半分は不要だという事です。

とはいえ、適用範囲がカンマでいくつにも区切られていたのでは見づらいです。
ここは頑張って、VBAコードをただひたすら書き足していきました。

同じ条件付き書式かどうかの判定は、

・数式1
・数式2
・表示形式
・太字
・文字色
・塗りつぶし


以上で判定しています。

従って、例えば、
A1:A10は、>1という条件でFont.Size = 10
A11:A20は、>1という条件でFont.Size = 11
これは、同じ条件付き書式として判定し統合されてしまいます。

実際に、このような設定を使う事があるとは思えませんが、
これを別の条件付き書式として判定したい場合は、
上記VBAコードの、
'追加判定したいプロパティはこの上に追加
これが3箇所ありますので、そこにプロパティを追加してください。


条件付き書式で設定できる書式

セルの書式設定のほとんどを指定できるので多くのプロパティがあります。

VBAでこの違いを全て判定するのは、ちょっとコードを書くのが面倒です。
特に罫線とかは、かなり多くなってしまいます。
実際のところは、
面倒と言うよりサンプルVBAコードとして長くなるだけで意味がないと思いました。

しかし、そもそも、
同じ数式、つまり同じ条件なのに書式のごく一部が違うというような設定を、
そんなに多用すること自体に問題があるようにも思いますし、
そんな使い方は、そうそうあるものではないだろうという思います。
そして、あくまでサンプルVBAだという事で理解してください。

以下は、設定できるプロパティの一覧になります。
NumberFormatLocal
Font.Bold
Font.Italic
Font.Underline
Font.Strikethrough
Font.Color
Font.TintAndShade
Borders(xlLeft).LineStyle
Borders(xlLeft).TintAndShade
Borders(xlLeft).Weight
Borders(xlRight).LineStyle
Borders(xlRight).TintAndShade
Borders(xlRight).Weight
Borders(xlTop).LineStyle
Borders(xlTop).TintAndShade
Borders(xlTop).Weight
Borders(xlBottom).LineStyle
Borders(xlBottom).TintAndShade
Borders(xlBottom).Weight
Interior.Pattern
Interior.PatternThemeColor
Interior.Color
Interior.TintAndShade
Interior.PatternTintAndShade
StopIfTrue
つまり、すべてのプロパティの違いを判定したいのなら、
先のVBAコードの、
'追加判定したいプロパティはこの上に追加
この部分に、既に入れてある、
NumberFormatLocal
Font.Bold
FontColor
InteriorColor
これ以外を全て追加すれば良いという事です。

ですが、正確にはこれで全てと言う訳ではありません。
塗りつぶし効果でグラデーションを付けている場合に、
その違いまで判定するなら、さらに多くのプロパティの判定が必要になります。

先にも述べましたが、同じ条件でグラデーションだけを変えるなどという使い方が実際にあるとは思えませんが、
もし使っているというのなら、基本的にシートの作成を考え直した方が良いと思います。


使い方

上記VBAコード先頭の、
「UnionFormatConditions」がメインのプロシージャーです。

オプションのNewNameが設定されていれば、
元シートをコピーしてから条件付き書式を整理統合します。

さすがにコードの詳細解説は無理です。
VBAコード内のコメントを参考にしてください。

以下で使い方を説明します。


アクティブシートの条件付き書式を整理統合
Sub sample1()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Call UnionFormatConditions(ws, ws.Name & "_test")
  
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

アクティブシートなので、念のためシートをコピーするオプションを指定しています。

整理統合されているかの確認をしやすいので、テスト用とも言えます。

ブック全てのシートの条件付き書式を整理統合する
Sub sample2()
  Dim FileName As Variant
  Dim wb As Workbook
  Dim ws As Worksheet
  
  FileName = Application.GetOpenFilename(FileFilter:="Excelファイル, *.xls*")
  If FileName = False Then
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  Set wb = Workbooks.Open(FileName:=FileName, UpdateLinks:=0, ReadOnly:=True)
  
  For Each ws In wb.Worksheets
    Call UnionFormatConditions(ws)
  Next
  
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  
  FileName = Application.GetSaveAsFilename(InitialFileName:=wb.Name, _
                       FileFilter:="Excelファイル,*.xls*")
  If FileName = False Then
    Exit Sub
  End If
  wb.SaveAs FileName
  wb.Close SaveChanges:=True
End Sub

ダイアログで対象のファイルを選択し、
保存時にもダイアログでファイルを指定できるようにしています。

全シートが変更になるので、別ブックで保存し確認できるようにしています。


最後に一言

こうやって、VBAコードを書いてみると、
Excelそのものも修正出来ないこともないように思われました。
「条件付き書式の最適化」
このようなボタンを配置して、条件付き書式を整理統合出来れば良いと思う。

・「もとに戻す」は難しいかもしれません。
・不具合も出るかもしれません。

実行時に注意のメッセージを出せば良いことではないかと思うのです。
特殊な使い方をしている場合を考慮して先に進まないよりは、
大多数の人の利益を優先すべきではないでしょうか。
それこそ最後には、「それは仕様です」、と言い切ってしまえば良い話だと私は思います。


今回のVBAは、コード量とその発想とその実現方法を考えると、
無料で公開するには、結構ギリギリなものではないかと思っています。
数独やオセロのVBAはこれよりはるかに長く難しいものですが、これらは遊びの範疇です。
しかし、今回の条件付き書式の統合は、完全に実用ソフトの部類になります。
無料でVBAコードを公開することは、VBAの作成を商売にしている人達にとって良い事なのかという疑問は残ります。
しかし、私自身が、
WEBで公開されているVBAコードに助けてもらう事も多々ありますので、
「相身互い」ということではないかと考えます。


まだ作成して自分で確認しただけのVBAなので、バグが無いとは言えません。
といいますか、このくらいのVBAになると、バグというか想定外は存在するのが普通です。
上記のVBAコードを使用して、Excelファイルが壊れてしまった等の苦情は受け付けませんが、
バグ報告は大歓迎です。
もしくは、
「もっと簡単にできるよ」、なんて情報は大大歓迎です。





同じテーマ「マクロVBAサンプル集」の記事

罫線を簡単に引く(Borders,BorderAround)
マクロの開始・終了(Applicationのプロパティ)
オートフィルター(AutoFilter)
日付のオートフィルタ(AutoFilter)
印刷ダイアログを使用する(xlDialogPrint)
名前定義の一覧(Name)
シートを名前順に並べ替える
数式内の不要なシート名を削除する(HasFormula)
数式の参照しているセルを取得する
条件付き書式で変更された書式を取得する

新着記事 ・・・新着記事一覧を見る

VBAを定型文で覚えよう|ExcelマクロVBA技術解説(3月26日)
VBAスタンダード試験対策まとめ|MOS VBAエキスパート対策(3月16日)
ユーザーフォームとメニューの操作|MOS VBAエキスパート対策(3月14日)
ファイルの操作|MOS VBAエキスパート対策(3月14日)
ユーザーフォームの各種イベント|Excelユーザーフォーム(3月13日)
レジストリの操作|MOS VBAエキスパート対策(3月12日)
変数と配列|MOS VBAエキスパート対策(3月12日)
Colorプロパティの設定値一覧|VBA技術解説(3月12日)
APIとOLEオートメーション|MOS VBAエキスパート対策(3月11日)
エラーへの対処|MOS VBAエキスパート対策(3月10日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.変数とデータ型(Dim)|ExcelマクロVBA入門
6.ひらがな⇔カタカナの変換|エクセル基本操作
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.定数と型宣言文字(Const)|ExcelマクロVBA入門
9.とにかく書いて見よう(Sub,End Sub)|VBA入門
10.繰り返し処理(For Next)|ExcelマクロVBA入門



  • >
  • >
  • >
  • 増殖した条件付き書式を整理統合する

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。





    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

    本文下部へ

    ↑ PAGE TOP