| |
▼なんじゃ、こりゃ・・・。 さん：
こんにちは。
単純にループさせてます。
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
|
|
Yuki
- 08/8/15(金) 14:31 -
