|
サンプルコードです。
Sub test1() '判定2の処理
Dim i As Long
Dim j As Long: j = 0 'j初期化
Dim RowE As Long
Dim FileNm As String
Dim Rn As Range
Dim StartAd As String
RowE = Range("E" & Rows.Count).End(xlUp).Row 'E列の最後の文字がある行数の値
For i = 2 To RowE
If Range("D" & i).Value = "" Then 'D列が空白の時
If Range("B" & i).Value = "" Then 'B列がまだ空白のとき
j = j + 1 'jに1を足す
FileNm = Range("E" & i).Value 'E列のファイル名を取得
Set Rn = Range("E2:E" & RowE).Find(What:=FileNm) 'E列を参照し同じファイル名のセルを探す
StartAd = Rn.Address '最初に見つけたセルのアドレスを覚えておく(取得)
Do
Range("B" & Rn.Row).Value = j 'B列の該当行に数字を記入
Set Rn = Range("E2:E" & RowE).FindNext(Rn) '他のセルに同じファイル名があるか探す
If Rn.Address = StartAd Then Exit Do '最初に見つけたセルのアドレスと同じならLoopをやめる
Loop '同じファイル名があるだけLoopする
Set Rn = Nothing 'Rnの解放(詳しくはHPなどで調べてください^^;)
End If
End If
Next 'E列に文字があるだけ繰り返します
End Sub
Sub test2() '判定3の処理
Dim i As Long
Dim RowA As Long
RowA = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To RowA
If Range("A" & i).Value = "×" And Range("B" & i).Value <> "" Then
If Range("B" & i).Value = Range("B" & i + 1).Value Then 'B列のセルの値と1つ下の値が同じ時、1つ下のセルと比較
If Range("F" & i).Value <> Range("F" & i + 1).Value And _
Range("G" & i).Value <> Range("G" & i + 1).Value Then '二つとも違う場合
Range("C" & i).Value = "サと時"
ElseIf Range("F" & i).Value <> Range("F" & i + 1).Value Then 'どちらかが一緒でサイズが違うとき
Range("C" & i).Value = "サイズ"
ElseIf Range("G" & i).Value <> Range("G" & i + 1).Value Then 'どちらかが一緒で時間が違うとき
Range("C" & i).Value = "時間"
End If
Else '違うとき、1つ上のセルを比較する
If Range("F" & i).Value <> Range("F" & i - 1).Value And _
Range("G" & i).Value <> Range("G" & i - 1).Value Then '二つとも違う場合
Range("C" & i).Value = "サと時"
ElseIf Range("F" & i).Value <> Range("F" & i - 1).Value Then 'どちらかが一緒でサイズが違うとき
Range("C" & i).Value = "サイズ"
ElseIf Range("G" & i).Value <> Range("G" & i - 1).Value Then 'どちらかが一緒で時間が違うとき
Range("C" & i).Value = "時間"
End If
End If
End If
Next 'A列に文字があるだけ繰り返す
End Sub
Sub test3() '判定2と判定3を一緒にしたもの
Dim i As Long
Dim j As Long: j = 0 'j初期化
Dim RowE As Long
Dim FileNm As String
Dim Rn As Range
Dim StartAd As String
RowE = Range("E" & Rows.Count).End(xlUp).Row 'E列の最後の文字がある行数の値
For i = 2 To RowE
If Range("D" & i).Value = "" Then 'D列が空白の時
If Range("B" & i).Value = "" Then 'B列がまだ空白のとき
j = j + 1 'jに1を足す
FileNm = Range("E" & i).Value 'E列のファイル名を取得
Set Rn = Range("E2:E" & RowE).Find(What:=FileNm) 'E列を参照し同じファイル名のセルを探す
StartAd = Rn.Address '最初に見つけたセルのアドレスを覚えておく(取得)
Do
Range("B" & Rn.Row).Value = j 'B列の該当行に数字を記入
Set Rn = Range("E2:E" & RowE).FindNext(Rn) '他のセルに同じファイル名があるか探す
If Rn.Address = StartAd Then Exit Do '最初に見つけたセルのアドレスと同じならLoopをやめる
Loop '同じファイル名があるだけLoopする
Set Rn = Nothing 'Rnの解放(詳しくはHPなどで調べてください^^;)
End If
End If
Next 'E列に文字があるだけ繰り返します
For i = 2 To RowE
If Range("A" & i).Value = "×" And Range("B" & i).Value <> "" Then
If Range("B" & i).Value = Range("B" & i + 1).Value Then 'B列のセルの値と1つ下の値が同じ時、1つ下のセルと比較
If Range("F" & i).Value <> Range("F" & i + 1).Value And _
Range("G" & i).Value <> Range("G" & i + 1).Value Then '二つとも違う場合
Range("C" & i).Value = "サと時"
ElseIf Range("F" & i).Value <> Range("F" & i + 1).Value Then 'どちらかが一緒でサイズが違うとき
Range("C" & i).Value = "サイズ"
ElseIf Range("G" & i).Value <> Range("G" & i + 1).Value Then 'どちらかが一緒で時間が違うとき
Range("C" & i).Value = "時間"
End If
Else '違うとき、1つ上のセルを比較する
If Range("F" & i).Value <> Range("F" & i - 1).Value And _
Range("G" & i).Value <> Range("G" & i - 1).Value Then '二つとも違う場合
Range("C" & i).Value = "サと時"
ElseIf Range("F" & i).Value <> Range("F" & i - 1).Value Then 'どちらかが一緒でサイズが違うとき
Range("C" & i).Value = "サイズ"
ElseIf Range("G" & i).Value <> Range("G" & i - 1).Value Then 'どちらかが一緒で時間が違うとき
Range("C" & i).Value = "時間"
End If
End If
End If
Next 'A列に文字があるだけ繰り返す
End Sub
|
|