Excel VBA質問箱 IV

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

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


35248 / 76732 ←次へ | 前へ→

【46685】Re:フォント色の指定について
回答  Hirofumi  - 07/2/12(月) 12:06 -

引用なし
パスワード
   こんな事なのかなぁ?

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim lngTop As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim strProm As String
  
  'Listの左上隅セル位置を基準として設定
  Set rngList = ActiveSheet.Cells(5, "G")
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  With rngList
'    'データ行数を取得 ★データ行数が不定で行数を取得する場合
'    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
'    'データが無い場合
'    If lngRows <= 1 And .Value = "" Then
'      strProm = "データが有りません"
'      GoTo Wayout
'    End If
    'データ行数を設定(G5〜G19) ★データ行数を予め指定する場合
    lngRows = 15
    'データを配列に取得
    vntData = .Resize(lngRows + 1).Value
    '番兵を設定
    vntData(lngRows + 1, 1) = Empty
    '範囲のフォントを初期化
    .Resize(lngRows).Font.ColorIndex = 0
    '同一セル値の先頭行初期値設定
    lngTop = 1
    '同一セル値のカウント初期値設定
    lngCount = 1
    'データ2行目〜最終行+1まで繰り返し
    For i = 2 To lngRows + 1
      '同一セル値先頭と現在行の値が違った場合
      If vntData(lngTop, 1) <> vntData(i, 1) Then
        '同一セル値先頭が""で無いなら
        If vntData(lngTop, 1) <> "" Then
          With .Offset(lngTop - 1)
            '同一値が1超える場合
            If lngCount > 1 Then
              'FontColorをWhiteに
              .Resize(lngCount - 1).Font.Color = vbWhite
            End If
            'FontColorをBlackに
            .Offset(lngCount - 1).Font.Color = vbBlack
          End With
        End If
        '同一セル値の先頭行を更新
        lngTop = i
        '同一セル値のカウント初期値設定
        lngCount = 1
      Else
        '同一セル値のカウントを更新
        lngCount = lngCount + 1
      End If
    Next i
  End With
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

1 hits

【46674】フォント色の指定について ayaka 07/2/12(月) 6:46 質問
【46675】Re:フォント色の指定について ichinose 07/2/12(月) 7:54 発言
【46676】Re:フォント色の指定について ayaka 07/2/12(月) 8:20 質問
【46677】Re:フォント色の指定について ichinose 07/2/12(月) 8:49 発言
【46678】Re:フォント色の指定について T 07/2/12(月) 9:04 発言
【46686】Re:フォント色の指定について Kein 07/2/12(月) 14:02 回答
【46679】Re:フォント色の指定について かみちゃん 07/2/12(月) 9:19 発言
【46680】Re:フォント色の指定について かみちゃん 07/2/12(月) 10:36 発言
【46700】Re:フォント色の指定について ayaka 07/2/12(月) 17:20 お礼
【46685】Re:フォント色の指定について Hirofumi 07/2/12(月) 12:06 回答

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