Question

我在这里有一个小难题＆amp;虽然网站上有一些建议，但没有什么比这更适合我。我需要根据行中某些单元格的值合并一些行。

我想我需要某种与该名称匹配的代码，然后搜索具有相同名称的“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

你可以在这里看到，圣诞老人并不是一个新手。因此保持为“现在”。

基本上，不需要“新入门”系列，但我确实希望为现有员工提供不同的细节。

附加说明：

如果存在“新起动器”，则“存在”行始终存在。如果他们有'休息日'，就会有一个“休息日”行，我已经将其包含在其他子集中以供提取。
要保留的数据是“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

第二种方法供您考虑，就数据位置而言，可能更具“通用”和“便携”。如果要在合并之前对数据进行排序，那么这将使用与Excel 2003兼容的替代（更长期？）Range.Sort方法。可以在msdn reference, here中找到用于优化此方法的其他参数。

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

使用Excel VBA查找列匹配＆amp;基于另外两列的值进行合并

2 个答案: