Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

24708 / 76732

←次へ　｜　前へ→


	【57371】Re:文字の色の同期と循環参照について

Yuki - 08/8/15(金) 14:31 -


	引用なし

	パスワード

▼なんじゃ、こりゃ・・・。さん：
こんにちは。

単純にループさせてます。
CもVBAも考え方は同じです。

標準モジュールにコーディング

入力後のチェック
最大値を文字色をセット
Sub TEST()
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim Ci1 As Long
　　Dim Ci2 As Long
　　Dim dt1 As Date
　　Dim dt2 As Date
　　Dim eR　As Long
　　
　　With Worksheets(1)
　　　　' A列の最大行取得
　　　　eR = .Range("A" & .Rows.Count).End(xlUp).Row
　　　　' 2行目から最大行迄Loop
　　　　For i = 2 To eR
　　　　　　' 2列目から最大列迄Loop (行列数は同じ）
　　　　　　For j = 2 To eR
　　　　　　　　' 行列が同じ番号だったら ===== を代入
　　　　　　　　If i = j Then .Cells(i, j).Value = "'====="
　　　　　　　　' セルの内容が日付だったら　列側
　　　　　　　　If IsDate(.Cells(i, j).Value) Then
　　　　　　　　　　' 大きい方の値をセット
　　　　　　　　　　If dt1 < .Cells(i, j).Value Then
　　　　　　　　　　　　dt1 = .Cells(i, j).Value
　　　　　　　　　　　　Ci1 = .Cells(i, j).Font.ColorIndex
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　' セルの内容が日付だったら　行側
　　　　　　　　If IsDate(.Cells(j, i).Value) Then
　　　　　　　　　　If dt2 < .Cells(j, i).Value Then
　　　　　　　　　　　　dt2 = .Cells(j, i).Value
　　　　　　　　　　　　Ci2 = .Cells(j, i).Font.ColorIndex
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Next
　　　　　　' 日付が無かったら
　　　　　　If dt1 = 0 Then
　　　　　　　　' クリア
　　　　　　　　.Cells(i, eR + 1).Value = Empty
　　　　　　Else
　　　　　　　　' 最大値と文字色をセット
　　　　　　　　.Cells(i, eR + 1).Value = dt1
　　　　　　　　.Cells(i, eR + 1).Font.ColorIndex = Ci1
　　　　　　End If
　　　　　　If dt2 = 0 Then
　　　　　　　　.Cells(eR + 1, i).Value = Empty
　　　　　　Else
　　　　　　　　.Cells(eR + 1, i).Value = dt2
　　　　　　　　.Cells(eR + 1, i).Font.ColorIndex = Ci2
　　　　　　End If
　　　　　　' 初期化
　　　　　　dt1 = 0
　　　　　　dt2 = 0
　　　　　　Ci1 = 0
　　　　　　Ci2 = 0
　　　　Next i
　　End With
End Sub

対象のシートモジュールに

セル範囲　Range("B2:K11") で日付入力があった対称のセルに ----- を入力
Private Sub Worksheet_Change(ByVal Target As Range)
　　If Intersect(Target, Range("B2:K11")) Is Nothing Then Exit Sub
　　If Target.Count > 1 Then Exit Sub
　　If IsDate(Target.Value) Then
　　　　Cells(Target.Column, Target.Row).Value = "-----"
　　Else
　　　　'
　　End If
End Sub

2 hits

▼

【57310】文字の色の同期と循環参照について なんじゃ、こりゃ・・・。 08/8/6(水) 11:48