VBA：自动找出酒店居住时间重复的客户记录

前言：群里有个需求，蛮有意思的

如上表所示，不同的用户有不同的入住时间和退房时间，那有的用户可能会同一天有2条酒店的居住记录，要找出这些记录。思路就是把格式转变为下表并算重复次数，把大于1的记录找出来再把序号剔重即可

Sub get_duplicates_row()

'Part1：改变原表形式
maxrow = Sheets("Sheet1").UsedRange.Rows.Count
'MsgBox (maxrow)

For i = 2 To maxrow
    xuhao = Sheets("Sheet1").Range("A" & i) '序号
    customer_name = Sheets("Sheet1").Range("B" & i) '用户名
    start_date = Sheets("Sheet1").Range("C" & i) '入住时间
    end_date = Sheets("Sheet1").Range("D" & i) '退房时间

    temp_date = end_date - start_date '入住天数（假设离店那天不算）
'    MsgBox (temp_date)
    temp_maxrow = Sheets("Sheet2").UsedRange.Rows.Count
    For j = 1 To temp_date
        new_row = j + temp_maxrow
        Sheets("Sheet2").Range("A" & new_row) = xuhao
        Sheets("Sheet2").Range("B" & new_row) = customer_name
        Sheets("Sheet2").Range("C" & new_row) = start_date - 1 + j
        Sheets("Sheet2").Range("D" & new_row) = customer_name & "+" & (start_date - 1 + j)
    Next
Next

'Part2:把之前做好表格，通过筛选、剔重等动作找到有重复记录的序号

sheet2_maxrow = Sheets("Sheet2").UsedRange.Rows.Count
Sheets("Sheet2").Select
Range("E2").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS(R2C4:R" & sheet2_maxrow & "C4,RC[-1])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E43")

Range("E2:E" & sheet2_maxrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
'Range("D1").Select
'Application.CutCopyMode = False
'Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$" & sheet2_maxrow).AutoFilter Field:=5, Criteria1:=">1", _
    Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Sheet3").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

sheet3_maxrow = Sheets("Sheet3").UsedRange.Rows.Count
ActiveSheet.Range("$A$1:$A$" & sheet3_maxrow).RemoveDuplicates Columns:=1, Header:=xlYes

'Part3：根据Part2的记录，把序号标黄

new_sheet3_maxrow = Sheets("Sheet3").UsedRange.Rows.Count
For i = 2 To new_sheet3_maxrow
    temp_xuhao = Sheets("Sheet3").Range("A" & i).Value + 1
'    MsgBox (temp_xuhao)

    Sheets("Sheet1").Select
    Range("A" & temp_xuhao).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next

End Sub