時間処理について（比較し含まれている方を消したい）

Question

前提・実現したいこと
1列の同じ項目内で時間を比較し、時間が含まれているほうの行を消したい
画像の赤枠が残るようにしたい

###発生している問題・エラーメッセージ
1行目の目次を比較してしまいエラーになる
また、無駄に1列を比較してしまっている

エラーメッセージ

###該当のソースコード
Sub test()
' Macro10 Macro
'' Macro7 Macro
'
Dim k, i, i2 As Long
Dim TMaxRow As Variant
Dim start, start2, ennd, ennd2 As Date

k = Range("A1").End(xlDown).Row
Stop

For i = k To 2 Step -1

For i2 = 1 To k - 2
start = Cells(i, "B") + Cells(i, "C")
ennd = Cells(i, "D") + Cells(i, "E")
start2 = Cells(i - i2, "B") + Cells(i - i2, "C")
ennd2 = Cells(i - i2, "D") + Cells(i - i2, "E")
Stop
If Cells(i, "A") = Cells(i - i2, "A") And start <= start2 And ennd >= ennd2 Then

Cells(i - i2, "B") = Cells(i, "B")
Cells(i - i2, "C") = Cells(i, "C")
Cells(i - i2, "D") = Cells(i, "D")
Cells(i - i2, "E") = Cells(i, "E")

Rows(i).Delete
GoTo LABEL1
End If

If Cells(i, "A") = Cells(i - i2, "A") And start >= start2 And ennd <= ennd2 Then

Rows(i).Delete
End If
LABEL1:
Stop
Next i2
Next i
End Sub
###試したこと
課題に対してアプローチしたことを記載してください
配列をつかおうとしたが、一行ずつ格納する方法がわからず、手じまい

Comments

[hatena19]

コード部分は、コードタグで囲んでください。コードを選択して、エディタのツールバーのコードボタン(</>)をクリックすると囲まれます。

Answer 1

質問者さんの現状のコードをなるべく活かして修正してみました。

• 変数宣言では、１行に記述する場合でも、一つずつ型を指定する、しないとVariant型になります。
• Gotoは使わない
• Cellsは列を英字で指定することは可能ですが、速度を重視するなら数字の方がベター、件数が多くなくて読みやすさを重視するなら英字もあり。

Sub test()
    Dim k As Long, i As Long, i2 As Long
    Dim start As Date, start2 As Date, ennd As Date, ennd2 As Date
    Dim name1 As String, name2 As String

    k = Range("A1").End(xlDown).Row
    
    '最終行から上に走査する
    For i = k To 3 Step -1
        '比較元
        name1 = Cells(i, "A")
        start = Cells(i, "B") + Cells(i, "C")
        ennd = Cells(i, "D") + Cells(i, "E")
        
        'iの一つ上から上に向かって走査する
        For i2 = i - 1 To 2 Step -1
            '比較先
            name2 = Cells(i2, "A")
            start2 = Cells(i2, "B") + Cells(i2, "C")
            ennd2 = Cells(i2, "D") + Cells(i2, "E")
            If name1 = name2 Then '名前が一致
                If start <= start2 And ennd >= ennd2 Then '比較先が比較元に含まれる
                    '比較元のデータを比較先にコピー
                    Cells(i2, "B") = Cells(i, "B")
                    Cells(i2, "C") = Cells(i, "C")
                    Cells(i2, "D") = Cells(i, "D")
                    Cells(i2, "E") = Cells(i, "E")
                    Rows(i).Delete '比較元行を削除
                ElseIf start >= start2 And ennd <= ennd2 Then '比較元が比較先に含まれる
                    Rows(i).Delete '比較元行を削除
                End If
            End If
        Next i2
    Next i
End Sub

「比較先が比較元に含まれる」場合、コピーせずに、比較先を削除して、上にずれた分iを補正してもOKです。

                If start <= start2 And ennd >= ennd2 Then '比較先が比較元に含まれる
                     Rows(i2).Delete '比較先行を削除
                     i = i - 1       '削除でずれた分の補正

Answer 2

動かしてはいませんが、こんな感じでいけませんか？

・次からはインデントをつけるようにしてくださいね。
・なるべくGotoを使うのは避けましょう
・cellでは、cell（1,1）のように、数字でアドレスを指定します。
→rangeでは、range（A1）のように、英字+数字の名前を使う時にはRangeを使ってください。

Sub test()
    Dim k, i, i2 As Long
    Dim TMaxRow As Variant
    Dim start, start2, ennd, ennd2 As Date
    Dim name, name2 as String '分かりやすいように名前変数を足しました

    k = Range("A1").End(xlDown).Row

    '下側から順番に走査する
    For i = k To 2 Step -1
        '「比較元」のデータ
        name = Cells(i, 1)
        start = Cells(i, 2) + Cells(i, 3)
        ennd = Cells(i, 4) + Cells(i, 5)

        'iの1つ上を起点に、下から順番に走査する
        '(i2を2行目まで走査してしまうと、i=i2の時に初めの行まで消されてしまうので注意です。)
        For i2 = k - 1 To 3 Step -1
            '「比較先」のデータ
            name2 = Cells(i2, 1)
            start2 = Cells(i2, 2) + Cells(i2, 3)
            ennd2 = Cells(i2, 4) + Cells(i2, 5)

            '名前が同じかつ、時間が同じとき
            If name = name2  And start = start2 And ennd = ennd2 Then

                '重複している行のうち、上側のものを削除
                Rows(i2).Delete
                
                'ズレた行数を補正
                i = i - 1
                i2 = i2 - 1
                
        Next i2
    Next i
End Sub