Excel VBA質問箱 IV

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

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


45701 / 76735 ←次へ | 前へ→

【36021】Re:コード簡略化のアドバイスを
発言  Hirofumi  - 06/3/19(日) 9:04 -

引用なし
パスワード
   たったら1ヶ月分だから、元のままでも支障は無いのでは?
遅いと言っても高が知れている?
ただ少し、コードを整理して見ました(多分速くは、成っていませんが?)

Option Explicit

Sub Test()
 
  Dim rngCurrent As Range
  Dim kei As Integer
  
  Set rngCurrent = ActiveSheet.Cells(4, 3)
  
  Application.ScreenUpdating = False
  
  With rngCurrent
    With .Resize(28, 31)
      .Borders(xlDiagonalDown).LineStyle = xlNone
      .Borders(xlDiagonalUp).LineStyle = xlNone
      With .Borders(xlEdgeLeft)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeTop)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeBottom)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeRight)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideVertical)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
    End With
    '青太線の出力
    For kei = 2 To 32
      With .Offset(, kei).Resize(28)
        Select Case .Item(2, 1).Value
          Case Is = 7
            With .Borders(xlEdgeLeft)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeTop)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeBottom)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
          Case Is = 1
            With .Borders(xlEdgeTop)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeBottom)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeRight)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
        End Select
      End With
    Next kei
  End With

  Set rngCurrent = Nothing
  
  Application.ScreenUpdating = True
  
End Sub
0 hits

【36019】コード簡略化のアドバイスを 春まき 06/3/19(日) 4:45 質問
【36021】Re:コード簡略化のアドバイスを Hirofumi 06/3/19(日) 9:04 発言
【36022】速い! 春まき 06/3/19(日) 10:08 お礼
【36055】再質問 春まき 06/3/20(月) 10:59 質問
【36065】Re:土日を青罫線で囲みたい かみちゃん 06/3/20(月) 13:06 回答
【36110】御返事遅くなりました 春まき 06/3/21(火) 0:40 お礼
【36111】Re:土日を青罫線で囲みたい かみちゃん 06/3/21(火) 10:44 発言
【36134】何度もすいません 春まき 06/3/22(水) 2:55 お礼
【36068】Re:再質問 Jaka 06/3/20(月) 13:35 発言
【36108】Jaka 様 春まき 06/3/21(火) 0:22 回答
【36135】使う上司の都合なんて知りませんが...。 Jaka 06/3/22(水) 9:34 発言
【36157】Re:使う上司の都合なんて知りませんが...。 春まき 06/3/22(水) 22:55 お礼
【36102】Re:再質問 Hirofumi 06/3/20(月) 19:54 回答
【36103】Re:再質問 かみちゃん 06/3/20(月) 20:14 発言
【36105】Re:再質問 Hirofumi 06/3/20(月) 22:25 回答

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