2

私はここでちょっとした難問を抱えており、サイトにはいくつかの提案がありますが、私にぴったりのものはありません. 行内のいくつかのセルの値に基づいて、いくつかの行をマージする必要があります。

名前に一致する何らかのコードが必要で、同じ名前の「New Starter」エントリを検索する必要があると思います。

私のデータ（シフト、名前、詳細）は次のようになります。

09:00-17:00 スミス・ジョンプレゼンツ
09:00-11:00 スミス・ジョン ニュースターター
11:10-13:00 スミス・ジョン ニュースターター
14:00-17:00 スミス・ジョン ニュースターター
09:00-17:00 コナー・サラプレゼンツ
09:00-11:00 コナー・サラ 新規スターター
11:10-13:00 コナー・サラ 新規スターター
14:00-17:00 コナー・サラ 新規スターター
09:00-17:00 クラウスサンタプレゼント
10:00～18:00 マウスミッキープレゼント
10:00-11:00 マウスミッキー ニュースターター
11:10-13:00 マウスミッキー ニュースターター
14:00-18:00 マウスミッキーニュースターター

New Starter 行 (存在する場合) を削除する必要がありますが、「Present」セルを「New Starter」に置き換える必要があります (ただし、必要に応じて別のテキストにすることもできます)。

09:00-17:00 スミス・ジョン ニュースターター
09:00-17:00 コナー・サラ 新規スターター
09:00-17:00 クラウスサンタプレゼント
10:00-18:00 マウスミッキーニュースターター

ここで、サンタは新規スターターではないため、「現在」のままであることがわかります。

基本的に、「新入社員」のセリフは必要ありませんが、新入社員には現在のスタッフとは異なる詳細を提供したいと考えています。

その他の注意事項：

  • 「New Starter」が存在する場合、「Present」行は常に存在します。彼らが「休日」を持っている場合は、抽出するために他のサブスクに既に含めた「休日」の行だけがあります。
  • 保持するデータは、「Present」行にあるものであり、そのタイトル (列 C) を置き換えるだけです。
4

2 に答える 2

2

次のコードは、条件に対処する必要があります。動作確認済み。

Sub RemoveDups()

Dim CurRow As Long, LastRow As Long, SrchRng As Range

LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Range("A1:C" & LastRow).Select
    Sheets(1).Sort.SortFields.Clear
    Sheets(1).Sort.SortFields.Add Key:=Range("B2:B" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Sheets(1).Sort.SortFields.Add Key:=Range("C2:C" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets(1).Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For CurRow = LastRow To 2 Step -1
    If Range("C" & CurRow).Value = "Present" Then
        If CurRow <> 2 Then
            If Not Range("B2:B" & CurRow - 1).Find(Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) is Nothing Then
                Range("C" & CurRow).Value = "New Starter"
            End If
        End If
    ElseIf Range("C" & CurRow).Value = "New Starter" Then
        Range("C" & CurRow).EntireRow.Delete xlShiftUp
    End If
Next CurRow

End Sub
于 2014-12-30T16:51:40.833 に答える