☰

合并连续日期的重复项，同时保留最早和最晚日期

tag-icon • tag-icon microsoft-excel vba
合并连续日期的重复项，同时保留最早和最晚日期

我一直在寻找，但找不到我想要完成的特定任务的解决方案。

我有一份巨大的电子表格，里面记录了我所管理的一家酒店两年内客人的住宿数据。许多客人延长了住宿时间，因此酒店会创建新的预订。我试图确定这些客人的实际入住和退房日期，以便了解我们实际的离店人数和实际的平均住宿时间。

本质上，我正在尝试找到一种方法，让 Excel 根据 3 列（房间/名字/姓氏）查找重复项，评估这些是否具有连续退房 = 入住日期，然后通过保留最早入住和最晚退房来合并这些。

以下为示例：

排 房间 名 姓 报到 查看
1 101 约翰 史密斯 2022 年 1 月 1 日 2022 年 2 月 1 日
2 102 路加 天空步行者 2022 年 1 月 1 日 2022 年 5 月 1 日
3 101 约翰 史密斯 2022 年 2 月 1 日 2022 年 3 月 1 日
4 103 约翰 史密斯 2022 年 3 月 1 日 2022 年 4 月 1 日
5 101 约翰 史密斯 2022 年 4 月 1 日 2022 年 5 月 1 日

在上面的例子中，第 1 行和第 3 行具有相同的房间号和名称，并且退房日期和入住日期也相同，则应将第 1 行的退房日期修改为第 3 行的退房日期，并删除第 3 行。

由于房间号不同，第 4 行应保持不变。

第 5 行应保持不变，因为办理登机手续不等于第 3 行办理登机手续。

最终结果是：

排 房间 名 姓 报到 查看
1 101 约翰 史密斯 2022 年 1 月 1 日 2022 年 3 月 1 日
2 102 路加 天空步行者 2022 年 1 月 1 日 2022 年 5 月 1 日
4 103 约翰 史密斯 2022 年 3 月 1 日 2022 年 4 月 1 日
5 101 约翰 史密斯 2022 年 4 月 1 日 2022 年 5 月 1 日

我认为最优雅的解决方案在于 VBA，尽管我对 VBA 的基本功能有一定的了解，但我无法弄清楚如何表达这一点。

我正在使用 Excel 365。

提前感谢您，如果您能提供任何建议，我们将不胜感激。

答案1

Power Query您可以使用Windows Excel 2010+ 和 Office 365 Excel 中提供的获取所需的输出

  • 选择原始表格中的某个单元格
  • Data => Get&Transform => From Table/Range或者From within sheet
  • 当 PQ UI 打开时，导航至Home => Advanced Editor
  • 记下代码第 2 行的表名称。
  • 用以下代码替换现有代码M 代码以下
  • 将粘贴代码第 2 行的表名更改为您的“真实”表名
  • 检查任何注释以及窗口Applied Steps，以更好地理解算法和步骤

M 代码

let

//Change next line to reflect actual data source/table in your workbook
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],

    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"Row", Int64.Type}, {"Room", Int64.Type}, 
        {"First Name", type text}, {"Last Name", type text}, 
        {"Check-in", type date}, {"Check-out", type date}}),

//Group by Room and names, then call custom function to merge rows if check-out = next check-in date
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Room", "First Name", "Last Name"},
        {"Stay", each fnMergeConsecutive(_),type table[Row=Int64.Type, Room=Int64.Type, First Name=text, Last Name=text, #"Check-in"=date, #"Check-out"=date]}),

//Remove unneeded columns
//Then expand the resultant sub-tables
    #"Removed Columns" = Table.RemoveColumns(#"Grouped Rows",{"Room", "First Name", "Last Name"}),
    #"Expanded Stay" = Table.ExpandTableColumn(#"Removed Columns", "Stay", 
        {"Row", "Room", "First Name", "Last Name", "Check-in", "Check-out"}),

//sort by check-in date
    #"Sorted Rows" = Table.Sort(#"Expanded Stay",{{"Check-in", Order.Ascending}, {"Room", Order.Ascending}})
in
    #"Sorted Rows"

通过将以下代码粘贴到另一个空白查询中来添加自定义函数。
重命名查询：fnMergeConsecutive

自定义功能M代码

//rename fnMergeConsecutive
(t as table) =>

let 

//if this check-in and previous check-out dates are the same, then replace this check-in with previous check-in
//then convert that list to a table
    #"Adjust Check-in Date" = List.Generate(
        ()=>[r=t{0}, idx=0],
        each [idx] < Table.RowCount(t),
        each [r= Record.TransformFields(t{[idx]+1},{"Check-in", (f)=> if f = [r][#"Check-out"] then [r][#"Check-in"] else f }),
        idx=[idx]+1],
        each [r]),
    #"Convert to Table" = Table.FromRecords(#"Adjust Check-in Date"), 

//Retain only the row with the latest check-out date for all rows with the same check-in date
    #"Return Stay Dates" = Table.Group(#"Convert to Table","Check-in",
        {"rsd", (t)=> Table.SelectRows(t, each [#"Check-out"] = List.Max(t[#"Check-out"])),
                type table[Row=Int64.Type, Room=Int64.Type, First Name=text, Last Name=text, #"Check-in"=date, #"Check-out"=date]}),

    #"Removed Columns" = Table.RemoveColumns(#"Return Stay Dates",{"Check-in"}),
    
    #"Expanded rsd" = Table.ExpandTableColumn(#"Removed Columns", "rsd",
        {"Row", "Room", "First Name", "Last Name", "Check-in", "Check-out"})
in
    #"Expanded rsd"

在此处输入图片描述

答案2

这解决了这个问题：

有重复项的工作表：

在此处输入图片描述

包含筛选记录的工作表：

在此处输入图片描述

    Private Sub CommandButton1_Click()
    
     Dim DbALLrecords, DuplicateRecords As Worksheet
     Set DbALLrecords = ThisWorkbook.Sheets("DUPL1")
     Set DuplicateRecords = ThisWorkbook.Sheets("DUPL2")

     DbALLrecords.Range("G1:K8").SpecialCells(xlCellTypeVisible).Copy
     DuplicateRecords.Cells(1, 1).PasteSpecial
    
    End Sub

注意：

  • 为了更快地使用，我创建了命令按钮，您可以使用此代码作为标准模块。
  • 代码将考虑房间号以及名字和姓氏的可见重复项从工作表 DUPL1 复制到工作表 DUPL2。
  • 根据需要调整单元格引用。

相关内容