| |
▼なんじゃ、こりゃ・・・。 さん：
こんにちは。
>（１）
>jのFor文が終わった後の
>「Next」
>は、jが抜けているだけでしょうか。それとも省略できるものなのでしょうか。
省略できます。For...Next ステートメントのヘルプの最後の方に書いてあります。
>（２）
>「' A列の最大行取得
>eR = .Range("A" & .Rows.Count).End(xlUp).Row」
>という命令は、値が連続して入っている範囲を知るものなのでしょうか。
>また、行列の数が一緒ではない可能性もあるので、行に対しても同様の処理を行ないたいと考えています。
>この場合、命令は
>' 1行の最大行取得
>eR = .Range("1" & .Rows.Count).End(xlUp).Row
>で良いのでしょうか。
eC = .Cells(1, .Columns.Count).End(xlToLeft).Column
>（３）
>dt1 dt2は最初値が何も入っていないのに、
>「If dt1 < .Cells(i, j).Value Then」 や
>「If dt2 < .Cells(j, i).Value Then」
>という比較が出来るということは、変数は最初に何らかの値に初期化されるという認識でよろしいのでしょうか。
Debug.Print dt1 とかを試してみればわかります。
>（４）
>「' 行列が同じ番号だったら ===== を代入
>If i = j Then .Cells(i, j).Value = "'====="」
>という部分ですが、行、列共に並べ替えられる可能性があるため、同じ名前が同じ番号に来るわけではないのです。
>そこで自分が考えているのは、
>まずＡ２とＢ１、Ａ２とＣ１・・・と比較していき、一致する名前があれば、対象セルに'=====を代入
>というのをＡ３、Ａ４・・・eRと繰り返していけば、実現できるのではないかと思います。
>このようなことが実現できる命令はありますでしょうか。
無いから自分で作ります。
>If i = j Then .Cells(i, j).Value = "'====="
↓
If .Cells(i, 1).Value = .Cells(1, j).Value Then .Cells(i, j).Value = "'====="
>（５）
>「対象のシートモジュールに」
>という部分ですが、ここがよく分かりません。
>もう一度例を挙げさせていただきます。
これは実行すべきシートのモジュールに書くということです。
VBE のプロジェクト エクスプローラの中に
Sheet1(Sheet1)
Sheet2(Sheet2) とかがありますから
対称のシートをWクリックするとそのシートモジュールが開きますよ。
とりあえず行列数バラバラでも動くコードを挙げておきます。
後は御自分で検討して下さい。
分かりやすくする為に速度等は考慮していません。
標準モジュールに
Sub TESTa()
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
Dim eC As Long
With Worksheets(1)
' A列の最大行取得
eR = .Range("A" & .Rows.Count).End(xlUp).Row
' １行目の最大桁取得
eC = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Rows(eR + 1).ClearContents
.Columns(eC + 1).ClearContents
行列数が違うと行側と列側の処理を分けたほうが分かりやすい｡
'最大列＋１にデータ
For i = 2 To eR
For j = 2 To eC
' 行列が同じデータだったら ===== を代入
If .Cells(i, 1).Value = .Cells(1, j).Value 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
Next
If dt1 = 0 Then
.Cells(i, eC + 1).Value = Empty
Else
.Cells(i, eC + 1).Value = dt1
.Cells(i, eC + 1).Font.ColorIndex = Ci1
End If
' 初期化
dt1 = 0
Ci1 = 0
Next
'最大行＋１にデータ
For j = 2 To eC
For i = 2 To eR
If IsDate(.Cells(i, j).Value) Then
If dt2 < .Cells(i, j).Value Then
dt2 = .Cells(i, j).Value
Ci2 = .Cells(i, j).Font.ColorIndex
End If
End If
Next
If dt2 = 0 Then
.Cells(eR + 1, j).Value = Empty
Else
.Cells(eR + 1, j).Value = dt2
.Cells(eR + 1, j).Font.ColorIndex = Ci2
End If
' 初期化
dt2 = 0
Ci2 = 0
Next
End With
End Sub
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
Dim eR As Long
Dim eC As Long
Dim tC As Long
Dim tR As Long
Dim cV As Variant
Dim rV As Variant
Dim i As Long
eR = Range("A" & Rows.Count).End(xlUp).Row
eC = Cells(1, Columns.Count).End(xlToLeft).Column
If Intersect(Target, Range(Cells(2, 2), Cells(eR, eC))) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If IsDate(Target.Value) Then
cV = Cells(1, Target.Column).Value
rV = Cells(Target.Row, 1).Value
For i = 1 To eR
If cV = Cells(i, 1).Value Then
tR = i
Exit For
End If
Next
For i = 1 To eC
If rV = Cells(1, i).Value Then
tC = i
Exit For
End If
Next
Cells(tR, tC).Value = "-----"
End If
End Sub
|
|
Yuki
- 08/8/16(土) 10:30 -
