2

我在这里有一个小难题，虽然网站上有一些建议，但没有什么能完全符合我的要求。我需要根据行中某些单元格的值合并一些行。

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

这是我的数据（班次、姓名、详细信息）的外观：

09:00-17:00 史密斯约翰出席
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 出席
09:00-11:00 Connor Sarah 新人
11:10-13:00 Connor Sarah 新人
14:00-17:00 Connor Sarah 新人首发
09:00-17:00 圣诞老人送礼
10:00-18:00 老鼠米奇礼物
10:00-11:00 鼠标米奇新首发
11:10-13:00 鼠标米奇新首发
14:00-18:00 鼠标米奇新首发

我需要删除 New Starter 行（如果它们存在），但还要用“New Starter”替换它们的“Present”单元格（尽管如果需要，这可以是不同的文本）：

09:00-17:00 Smith John New Starter
09:00-17:00 Connor Sarah 新人
09:00-17:00 圣诞老人送礼
10:00-18:00 鼠标米奇新首发

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

本质上，“新入门”系列是不需要的，但我确实想给新入门者一个不同的细节给现在的员工。

补充说明：

  • 如果存在“New Starter”，则始终存在“Present”行。如果他们有“休息日”，那么只会有一条“休息日”行，我已经将其包含在其他 Subs 中以提取。
  • 要保留的数据是“当前”行中的任何内容，仅替换该标题（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 回答
1

第二种方法供您考虑，就数据的位置而言，可能更“通用”和“便携”。如果您想在合并之前对数据进行排序，那么这将使用与 Excel 2003 兼容的替代（更长期？）Range.Sort方法。可以在msdn 参考中找到进一步改进此方法的参数，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
于 2014-12-30T21:13:56.423 回答