Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1555 / 13644 ツリー ←次へ | 前へ→

【73476】罫線を引きたい のうさぎ 13/1/14(月) 20:06 質問[未読]
【73524】Re:罫線を引きたい のうさぎ 13/1/17(木) 22:11 質問[未読]
【73526】Re:罫線を引きたい UO3 13/1/18(金) 9:12 発言[未読]
【73556】Re:罫線を引きたい のうさぎ 13/1/21(月) 0:38 お礼[未読]

【73476】罫線を引きたい
質問  のうさぎ  - 13/1/14(月) 20:06 -

引用なし
パスワード
   はじめまして。お世話になります。

   A    B   …
1 チョコ
2 アイス
3 チョコ
4 アイス
5 キャンディ
6 アイス
7 ガム

200 キャンディ


上のようにA列に (チョコ アイス キャンディ ガム)の4つのワードが
ランダムにたくさん入力されています。行の数はだいたい200で、4つの
ワードの入力数の割合はバラバラです。
いま、これをA列でソート(ソートの順はこだわりません)して、ソート後、
ワードが変わるところ(チョコとアイスの間、アイスとキャンディの間、等)
で2重線を、そして、チョコならチョコだけの中で上から順番に5行ずつ、
ふつうの一重の罫線を、アイスならアイスだけの中で上から順番に5行ずつ
ふつうの一重の罫線をいれたいのです。ただし、ワードが4つ以下(例えば
チョコが4つしか入力されていなかった)であれば、ソート後、チョコのなか
には一重の罫線はひく必要はありません。
どうか皆様のお知恵をお貸し下さい。
 

【73524】Re:罫線を引きたい
質問  のうさぎ  - 13/1/17(木) 22:11 -

引用なし
パスワード
   Sub お菓子が変われば二重罫線()


  Dim i
  For i = 1 To 200
    Range("A" & i).Select
    If Range("A" & i).Value <> Range("A" & i + 1).Value Then
      With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
      End With
      
    End If
  Next

End Sub

上のように、お菓子の名前が変われば、変わった行で二重線を引くことは
できるのですが、その後、同じお菓子の言葉内で、言葉が変わった行から
5行ごとに一重線を引くことができません。
ご教授、アドバイスをいただけたらと思います。よろしくお願いします

【73526】Re:罫線を引きたい
発言  UO3  - 13/1/18(金) 9:12 -

引用なし
パスワード
   ▼のうさぎ さん:

おはようございます
一例です

Sub Sample()
  Dim i As Long
  Dim z As Long
  Dim cnt As Long
  Dim myStyle As Long
  Dim myWeight As Long
  
  '処理前にA列の罫線があれば削除
  Columns("A").Borders.LineStyle = xlNone
  'A列データ最終行の取得
  z = Range("A" & Rows.Count).End(xlUp).Row
  cnt = 1
  '2行目から最終行の次の行までループ処理
  For i = 2 To z + 1
    myStyle = 0
    '前の行と値がかわったか?
    If Range("A" & i).Value <> Range("A" & i - 1).Value Then
      cnt = 1
      myStyle = xlDouble '二重線
      myWeight = xlThick
    Else
      cnt = cnt + 1
      '5行おきに線
      If (cnt - 1) Mod 5 = 0 Then
        myStyle = xlContinuous
        myWeight = xlThin
      End If
    End If
    
    If myStyle Then 'スタイルがセットされていたら
      With Range("A" & i).Borders(xlEdgeTop)
        .LineStyle = myStyle
        .Weight = myWeight
        .ColorIndex = xlAutomatic
      End With
    End If
  Next
    
End Sub

【73556】Re:罫線を引きたい
お礼  のうさぎ  - 13/1/21(月) 0:38 -

引用なし
パスワード
   ▼UO3 さん:

返事がおそくなって申し訳ありません。
教えていただいたコードで望みどおりの
罫線を引くことができるようになりました。
わかりやすいコメントまでつけていただいて
本当にわかりやすかったです。
この度は本当にありがとうございました。

1555 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free