欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页

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

程序员文章站 2022-03-16 18:51:34
...

前言:群里有个需求,蛮有意思的
VBA:自动找出酒店居住时间重复的客户记录
如上表所示,不同的用户有不同的入住时间和退房时间,那有的用户可能会同一天有2条酒店的居住记录,要找出这些记录。思路就是把格式转变为下表并算重复次数,把大于1的记录找出来再把序号剔重即可
VBA:自动找出酒店居住时间重复的客户记录

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

相关标签: VBA