Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
同じ範囲に罫線を引く方法
投稿日時: 20/12/24 10:44:20
投稿者: rinahana

いつもお世話になっております。稚拙なVBAで地域に少しでも役に立てればと思って参加している地域町会の係をしています。
使用しているソフトはマイクロソフトのエクセルとワードです。
エクセルで”罫線を引く”作業は割と細かな、時間のかかるもので、しかも出来上がりで色々とミス(コピー後も)があるものです。
今 チャレンジしているのが、行30飛び、列20飛び(表と表の境界は空白行、列を1つ空ける)で表が存在し、その表を同じ罫線
を施すというコードです。例えば、町会を構成する班の構成メンバーの表を横4つ、縦5つの20班を想定するが班の人数はそれぞれ違いがあります。10から26軒です)
で、マクロ記録を使って、下記の記録を取りました。
そこで、これが一番左上の表の範囲だとして、2重ループ(for---next)で罫線を引きたいと思うのですが横・縦の移動を「CurrentRegion」でできないものでしょうか。
 
    Selection.CurrentRegion.Select
    s = ActiveCell.CurrentRegion.Columns.Count
    Selection.Borders.LineStyle = True
 
   「 s = ActiveCell.CurrentRegion.Columns.Count」これは Web検索で得たコードですが、それ以上うまく出来ませんでした。
  Selection.Resize(cntRow, cntCol).Selectや .Offset(1, 0).Resizeなども読みましたが、スッキリとした感覚がつかめなくて、利用までにはいたりませんでした。
どうかヒントやお教えをおねがいします。
よろしく

回答
投稿日時: 20/12/24 11:14:42
投稿者: sk

引用:
行30飛び、列20飛び(表と表の境界は空白行、列を1つ空ける)で
表が存在し、その表を同じ罫線を施す

引用:
例えば、町会を構成する班の構成メンバーの表を横4つ、縦5つの
20班を想定するが班の人数はそれぞれ違いがあります

(標準モジュール)
--------------------------------------------------------------
Sub SetBordersByRegion()
 
    Dim ws As Worksheet
     
    Set ws = Worksheets(1)
     
    ws.Cells.Borders.LineStyle = xlNone
     
    Dim rngAreas As Range
    Dim rngArea As Range
    Dim rngRegions As Range
     
    On Error Resume Next
    Set rngAreas = ws.UsedRange.SpecialCells(xlCellTypeConstants)
     
    If Err.Number = 1004 Then
        MsgBox "[" & ws.Name & "]に定数セルは存在しません。", vbExclamation
        Set ws = Nothing
        Exit Sub
    End If
     
    On Error GoTo 0
     
    For Each rngArea In rngAreas
        If rngRegions Is Nothing Then
            Set rngRegions = rngArea.CurrentRegion
        Else
            Set rngRegions = Union(rngRegions, rngArea.CurrentRegion)
        End If
    Next
     
    For Each rngArea In rngRegions
        With rngArea.Borders
            .LineStyle = xlContinuous
            .Color = RGB(255, 0, 0)
            .Weight = xlThin
        End With
    Next
 
    Set rngAreas = Nothing
    Set ws = Nothing
     
End Sub
--------------------------------------------------------------
 
以上のような処理を実行なさりたい、ということでしょうか。

回答
投稿日時: 20/12/24 11:15:02
投稿者: Suzu

引用:
行30飛び、列20飛び(表と表の境界は空白行、列を1つ空ける)

引用:
Selection.CurrentRegion.Select
Selection.Borders.LineStyle = True
なのであれば、
 
Sub Sample()
 Const rOffset As Long = 30
 Const cOffset As Long = 20
 
 Dim i As Long
 Dim j As Long
 
 For i = 1 To 5
  For j = 1 To 4
   Cells((i - 1) * rOffset + i, (j - 1) * cOffset + j) _
           .Resize(rOffset, cOffset).Borders.LineStyle = True
  Next
 Next
End Sub
 
コードを組み、検証する時間を考えれば 手動でコピペした方が早ですし
繰り返し使う表であれば、雛形シートを用意しておけば良さそうな気がします。

回答
投稿日時: 20/12/24 11:26:12
投稿者: WinArrow
投稿者のウェブサイトに移動

私も町会の仕事で、一斉清掃出欠表を作成しています。
その方法を紹介します。
 
表のイメージを説明します。
班が9個、班内の隣組が2〜14個
隣組内世帯が1〜20戸
表は、A4縦方向に、隣組をできるだけ詰める。(縦に2つの隣組となることも、3つになることもある)
 
思想としては、縦方向に改ページはしない、横方向の改ページのみで対応する。
 
隣組の戸数は予め把握できるので、
それを貼り付けたら、A4の1ページの設定行数の超えるならば、
横に並べる(改ページを設定)
勿論、班は変わったら横に貼付け(改ページ設定)します。
 
縦方向に貼り付ける場合、空白行を入れる。
横方向に貼り付ける場合は、空白列を入れる。
※この空白行、空白列は、CurentRegionでセル範囲を参照するためです。
 
貼り付けたセル範囲は、CurentRegionで認識できるので
敢えて行数を取得しなくても罫線の設定は可能です。
 

 

回答
投稿日時: 20/12/24 11:29:10
投稿者: sk

訂正:

引用:
For Each rngArea In rngRegions

For Each rngArea In rngRegions.Areas

回答
投稿日時: 20/12/24 11:29:57
投稿者: WinArrow
投稿者のウェブサイトに移動

↑の紹介は、貼付けの都度、罫線を設定する方法です。

投稿日時: 20/12/24 11:32:47
投稿者: rinahana

 skさん、WinArrowさん ありがとうございます。
コードを見ているだけでは、むずかいくて、分からないので、しばらくランをやって見るので
その後の感謝になりますが、どうぞご理解ください。

回答
投稿日時: 20/12/24 11:41:27
投稿者: mattuwan44

Sub test()
    Dim Rng As Range
    Dim a As Range
    
    On Error Resume Next
    Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Rng Is noting Then Exit Sub
    
    For Each a In Rng.Areas
        a.Select
        Stop
        a.CurrentRegion.Borders.LineStyle = True
    Next
End Sub

 
ジャンプ機能で値が入っているセルを検索し、
その飛び飛びのセルの集まりはAreasで巡回します。
 
Selectは主目的ではないので、Selectすることは無駄です。
動作確認済んだらStopも含め、削除願います。

投稿日時: 20/12/24 12:38:22
投稿者: rinahana

skさん、 WinArrowさん、 mattuwan44さん
本当にありがとうございます。
WinArrowさんのfor-next はばっちり 思い通りの結果がでました。ありがとうございいます。
skさんと mattuwan44さんのコードはこれからです。ありがとうございます。
それとWinArrowさんの町会の話は大変参考になります。ありがとうございます。

回答
投稿日時: 20/12/24 18:16:10
投稿者: WinArrow
投稿者のウェブサイトに移動

>WinArrowさんのfor-next はばっちり 思い通りの結果がでました。ありがとうございいます
私のレスの中には、For〜Nextのコード記述はありませんので、
確認して、しかるべき回答者に変更してください。

投稿日時: 20/12/25 14:19:08
投稿者: rinahana

 skさんコードは小生にとっては、かなり難しいので、100%は理解できないのですが、何をやっているのかは、少し分かります。

質問 定数(数値や文字)がある部分に罫線を引く というのは、分かりましたし、罫線の色も帰る頃ができました。また罫線の種類もわかりました。
あと、罫線を左に指定した数分(1から5ぐらい)、または次の右にある定数の一つ手前まで罫線を引きたいのですが可能ですか?次の右にある定数の一つ手前までが小生に理解が難しいのであれば、決まった数だけ罫線を増やすでもいいのですが。
お願いします。
 

回答
投稿日時: 20/12/25 15:11:19
投稿者: sk

回答する前に、もう 1 箇所だけ訂正しておきます。
(そのままでも一応動作はしますが、念のため)
 

引用:
For Each rngArea In rngAreas

For Each rngArea In rngAreas.Areas
 
引用:
定数(数値や文字)がある部分に罫線を引く というのは、分かりましたし、
罫線の色も帰る頃ができました。また罫線の種類もわかりました

正しくは「定数セルが含まれているアクティブセル領域
(空白行と空白列で囲まれたセル範囲)」に、です。
 
それぞれのアクティブセル領域内の全てのセルが
定数セルのみになるとは限りません。
 
例えば A1 セルに何らかの定数が、 B2 セルに何らかの数式が
入力されていて、かつそれらを除く全てのセルが空白セルである場合、
セル範囲 A1:B2(空白セルである A2 セルと B1 セルを含む)が
1 つのアクティブセル領域(矩形範囲)となります。
 
また、先の回答で例示したサンプルコードは、あくまで
「それぞれのアクティブセル領域には、必ず 1 つ以上の
定数セルが含まれている」と仮定して組み上げたものに過ぎません。
 
もし「数式セル(と空白セル)で構成されたアクティブセル領域」が
存在した場合、その領域に対しては前述のコードによって
罫線が設定されることはありません。
 
引用:
罫線を左に指定した数分(1から5ぐらい)、
または次の右にある定数の一つ手前まで
罫線を引きたいのですが可能ですか?

以上のことを踏まえられた上で、どのような目的から
そのようなことをなさろうとしているかについて
具体的に明記されることをお奨めします。

投稿日時: 20/12/26 17:05:21
投稿者: rinahana

 沢山の方々に教えを頂きありがとうございます。
現在はmattuwan44さんのコードを実践中ですが、色々と勉強になります。
 
終りの forループの部分ですが、罫線が思うように引けないので、
For Each a In Rng.Areas
     a.Select
  a.Resize(Selection.Rows.Count + 22, Selection.Columns.Count + 4).Select
  Stop
  Selection.CurrentRegion.Borders.LineStyle = True
Next

のように追加して、やってみました。どうもうまくいきません。
シート上には班の人数分の番号と名前が
既に A2〜F24 1列開けて、次のh2〜M24 1列開けてと最後AJ2〜AO24 の6つの表が並び
   各列の下に次の班の番号と名前が並んでいます。班の人数は10であってもセルは24取ってあります。現在のシートは縦に8つの表(6×8)の名簿は並んでいます。
そこに、24×6の大きさに罫線を引くコードを作りたいのです。
 
  Suzuさんのコードで出来てはいるのですが、  
 
  ”For Each a In Rng.Areas” の a にはデバッグでは班の番号が表示されるのですが、
  range変数がどうなっているのか?が分かりませんし、罫線がセル全体引かれてしまいます。
  チョト教えてもらえませんか。お願いします。
  

回答
投稿日時: 20/12/26 20:50:15
投稿者: WinArrow
投稿者のウェブサイトに移動

>うまくいかない
どのようにうまくいかないのか説明が不足しています。
回答者には、あなたのPCの画面は見えませんから、
回答者にも見えるような説明をしましょう・・・・
 
下手な鉄砲でも、いろいろやってりゃ当たる的な
やみくもに、余計なコードをいっぱい突っ込んでいる感じがします。
 
 

For Each a In Rng.Areas 
      a.Select 
   a.Resize(Selection.Rows.Count + 22, Selection.Columns.Count + 4).Select 
   Stop 
   Selection.CurrentRegion.Borders.LineStyle = True 
 Next


↓のように変更して「a」の範囲を確認してみましょう。
   
 
For Each a In Rng.Areas
      Debug.print a.Address
Next
 
このコードはあなたが意図したようにセル範囲が認識できているか
を検証するためのものです。
これが、意図したセル範囲ではない場合、
あなたが「空白」と表現しているセルに何か入っていることになります。
 
目視で空白に見えていても、空白文字列が入っていることあるからね・・・・

投稿日時: 20/12/26 22:39:42
投稿者: rinahana

皆さんのお陰で、やりたいことがほぼ出来ました。
ジャンプ⇒選択オプションをVBAで便利に利用できることが少しわかりました。
ありがとうございました。
全てを理解することはまだ 時間が必要ですが、年末年始の時間を利用して取り組んでいきたいと思います。
で 下記のコードで思い通りの罫線が引けたのですが、
@ Ifの文がエラーが出るので、コメント文で凌いでおります。
A a.Select の行から3つにselectが並んで使用しているのが、もっとすっきりできないか?
この点を教えてください。 +4は4列右まで罫線を引くためなのです。
 
---------------------------------------------------、
       Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
' If Rng Is noting Then Exit Sub
    For Each a In Rng.Areas
        a.Select
        Selection.Resize(, Selection.Columns.Count + 4).Select
        Selection.Borders.LineStyle = True
    Next
---------------------------------------------------、
以上よろしくお願いいたします。

回答
投稿日時: 20/12/27 07:57:03
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

で 下記のコードで思い通りの罫線が引けたのですが、
@ Ifの文がエラーが出るので、コメント文で凌いでおります。
A a.Select の行から3つにselectが並んで使用しているのが、もっとすっきりできないか?
この点を教えてください。 +4は4列右まで罫線を引くためなのです。
  
---------------------------------------------------、
       Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
 ' If Rng Is noting Then Exit Sub
     For Each a In Rng.Areas
         a.Select
         Selection.Resize(, Selection.Columns.Count + 4).Select
         Selection.Borders.LineStyle = True
     Next
---------------------------------------------------、
 以上よろしくお願いいたします。

 
端的にいえば、
あなたの説明とデータに違いがあるということではないでしょうか?
 
あなたは、
30行x20列を1つの塊で、塊の間には、空白行、空白列が存在する
と説明しています。
しかし、現在テスト中のデータには、20列の中に空白の列が存在するということではないでしょうか?
それを確認する意味で
Debg.Print a.Address
を実行するようアドバイスしたんですが、無視されたようですね?
 
現在テスト中のデータが全てなのか? 
たまたま、そのようなデータを使っているか?
本来の仕様通りのデータで、対応すべきです。
それを回答者に確認しても無理、無理
 
ついでに書いておきますが、
        a.Select 
         Selection.Resize(, Selection.Columns.Count + 4).Select 
         Selection.Borders.LineStyle = True 

は、無駄が多い。
        a.Resize(, a.Columns.Count + 4).Borders.LineStyle = True
で充分です。
 
 

回答
投稿日時: 20/12/27 13:29:49
投稿者: WinArrow
投稿者のウェブサイトに移動

一つ、疑問があります。
 
20列の中に「数式」が入っているセル(列)はありませんか?
>.SpecialCells(xlCellTypeConstants)
で取得するセル範囲は、「定数」だけが対象となります。
0列の中に数式セルの列が存在すると、20列が分断されます。
そのあたりを明確にしないまま、鉄砲を撃っても
いつかは当たるかもしれませんが、効率が悪い。

投稿日時: 20/12/27 13:39:49
投稿者: rinahana

WinArrowさん すみませんでした。
大変紛らわしい質問で、本当に失礼しました。
小生の中には8×6の48の班の名簿?ができれば、あとは10×10であっても対応できるだろうとの
気持ちがあり、数を重視していなかったところが間違いであり、皆様に大変ご迷惑をおかけした点です。
すみません。実際のところ、WinArrowさんに記述していただいた、1行のコードで全ての疑問が解消されました。コードと実体が一致しない点(知識不足で)があり、薄っすらと理解できたように思います。
プログラミングでは”薄っすらと”は許せないのでしょうが、今の私には喜びしかありません。
長い時間をお相手下さり、誠にありがとうございました。