使用Excel VBA查找列匹配项并基于其他两个列的值合并

Question

我在这里有一个难题，尽管网站上有一些建议，但没有什么适合我。 我需要根据行中某些单元格的值合并一些行。

我想我需要某种与名称匹配的代码，然后搜索具有相同名称的“ New Starter”条目。

这是我的数据（Shift，名称，详细信息）的外观：

09:00-17:00 Smith John      Present
09:00-11:00 Smith John      New Starter
11:10-13:00 Smith John      New Starter
14:00-17:00 Smith John      New Starter
09:00-17:00 Connor Sarah    Present
09:00-11:00 Connor Sarah    New Starter
11:10-13:00 Connor Sarah    New Starter
14:00-17:00 Connor Sarah    New Starter
09:00-17:00 Claus Santa     Present
10:00-18:00 Mouse Mickey    Present
10:00-11:00 Mouse Mickey    New Starter
11:10-13:00 Mouse Mickey    New Starter
14:00-18:00 Mouse Mickey    New Starter

我需要删除“ New Starter”行（如果存在），还需要用““ New Starter””替换其“ Present”单元格（尽管如果需要，可以是其他文本）：

09:00-17:00 Smith John      New Starter
09:00-17:00 Connor Sarah    New Starter
09:00-17:00 Claus Santa     Present
10:00-18:00 Mouse Mickey    New Starter

您可以在此处看到圣诞老人不是新手，因此保持为“当前”状态。

从本质上讲，不需要“新手”行，但是我确实想给新手给现任员工一个不同的细节。

补充笔记：

• 如果存在“ New Starter”，则“ Present”行将始终存在。 如果他们有“休息日”，则只有一条“休息日”行，我已经将其包含在其他Subs中以进行提取。
• 要保留的数据是“ Present”行中的内容，仅替换该标题（C列）。

Answer 1

以下代码应满足您的条件。 经过测试的工作。

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

Answer 2

让您考虑的第二种方法，就数据的位置而言，也许更“通用”和“便携式”。 如果要在合并之前对数据进行排序，则使用替代方法（长期存在吗？） Range.Sort方法可兼容Excel2003。有关改进此方法的其他参数，请参见msdn参考，此处

Option Explicit
Sub newStarters()
Dim ws As Worksheet
Dim dRng As Range
Dim stRow As Long, endRow As Long, nameCol As Long, c As Long
Dim nme As String, changeStr As String

'explicitly identify data sheet
Set ws = Sheets("Data")
'start row of data
stRow = 2
'column number of "Name"
nameCol = 3
'set changeStr
changeStr = "New Starter"

    'Use the explicit data sheet
    With ws
        'find last data row
        endRow = .Cells(Rows.Count, nameCol).End(xlUp).Row

        'if you want the data to be sorted before consolidating
        '======================================================
        'Set dRng = .Range(.Cells(stRow, nameCol).Offset(0, -1), _
        '            .Cells(endRow, nameCol).Offset(0, 1))

        'dRng.Sort Key1:=.Cells(stRow, nameCol), Order1:=xlAscending, _
        '          Key2:=.Cells(stRow, nameCol).Offset(0, 1), Order2:=xlDescending, _
        '          Header:=xlNo
        '======================================================
            'consolidate data
            For c = endRow To stRow Step -1
                With .Cells(c, nameCol)
                    nme = .Value
                        If .Offset(0, 1).Value = changeStr Then
                            If .Offset(-1, 0).Value = nme Then
                                .Offset(-1, 1).Value = changeStr
                                .EntireRow.Delete xlShiftUp
                            End If
                        End If
                End With
            Next c
    End With

End Sub