在Excel中选择最新记录并创建唯一值的新表

时间:2016-08-09 20:16:31

标签: excel excel-vba vba

我有一张Excel表格,用于记录企业内工作站的车辆进度。可以多次访问给定的工作站。

车辆牌照号码(Reg No)用于识别车辆,当车辆到达下一个新工作站时,用户将新行添加到电子表格中。除了Reg No,每行还有一个记录ID。

此工作流程意味着将为给定的注册号

创建多个记录行

当车辆上的所有工作完成后,记录将被剪切并存档在另一张工作表上。

Current Vehicle Table

我想要创建的是另一个工作表选项卡上的摘要表,它显示正在进行的车辆的所有行。如果车辆当前有单个记录,我想提取该记录行,并且车辆有多个记录,我想只提取最后一个(最近的)记录行。

我希望摘要能够成为基础数据表的“实时”反映。

从搜索中我发现了Ignore Duplicates and Create New List of Unique Values in Excel的公式示例,但这些示例默认选择第一个重复值,而不是最后一个。 “查找最后匹配”或“返回最后一个值”的搜索结果的共同点是用户必须定义​​他们要搜索的项目。

我认为我需要一些不同的东西,因为我的Reg No列表并不是静态的 - Reg No的被添加和删除(存档)不断刷新。

确认和理解Excel不是一个数据库,但如果我在思考数据库/ SQL术语,我的(noob)查询可能是这样的: SELECT行 Reg No Reg是唯一的 AND记录ID最大

您知道在Excel中实现我所寻求的结果的任何方法吗?

2 个答案:

答案 0 :(得分:4)

您可以使用数据透视表和查找公式来完成此任务。下面是Excel表格(也就是ListObject)中的一些简化数据,下面是一个数据透视表,在右侧有一个合适的查找公式。

enter image description here

数据透视表中包含Reg No以及值(聚合)区域中的RecordID字段,设置在' Max'上。所以基本上它显示每个Reg No的最大RecordID值,然后在右边的列中有一个INDEX / MATCH公式,它在数据输入表中查找RecordID,并返回关联的Stage。

它不是完全直播,因为您需要刷新数据透视表,并且您需要确保已将Lookup公式复制到足以处理大小的数据透视表。

只需在工作表中放入一个Worksheet_Activate事件处理程序,即可轻松实现刷新自动化。像这样的东西: Private Sub Worksheet_Activate()     Activesheet.PivotTables("数据透视表&#34)PivotCache.Refresh。 结束子

由于我们现在涉及VBA,您可能还有一些代码可以将公式复制到数据透视表旁边所需的行数。我会在适当的时候鞭打一些东西并在这里发布。

更新: 我已经编写了一些代码来将Table从表转移到数据透视表,因此数据透视表的维度或位置的任何更改都将反映在阴影表的维度和位置中。这有效地为我们提供了一种方法来将计算字段添加到数据透视表,该数据透视表可以引用该数据透视表的外部,因为我们在这里使用INDEX / MATCH查找。我们将该功能称为计算表

如果数据透视表增长,则计算表将增长。如果数据透视表收缩,则计算表将缩小,其中的任何冗余公式都将被删除。以下是您查找示例的方式:顶部表格来自输入表格,下方的数据透视表和计算表格来自结果表格。< / p>

enter image description here

如果我转到输入表并添加更多数据,那么当我切换回结果表时,数据透视表会自动使用该新数据进行更新,并且计算表会自动扩展以容纳额外的行: enter image description here

以下是我用来自动执行此操作的代码:

Option Explicit

Private Sub Worksheet_Activate()
    ActiveSheet.PivotTables("Report").PivotCache.Refresh
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    If Target.Name = "Report" Then _
        PT_SyncTable Target, ActiveSheet.ListObjects("SyncedTable")
End Sub


Sub PT_SyncTable(oPT As PivotTable, _
                oLO As ListObject, _
                Optional bIncludeTotal As Boolean = False)

    Dim lLO As Long
    Dim lPT As Long

    'Make sure oLO is in same row
    If oLO.Range.Cells(1).Row <> oPT.RowRange.Cells(1).Row Then
        oLO.Range.Cut Intersect(oPT.RowRange.EntireRow, oLO.Range.EntireColumn).Cells(1, 1)
    End If

    'Resize oLO if required
    lLO = oLO.Range.Rows.Count
    lPT = oPT.RowRange.Rows.Count
    If Not bIncludeTotal And oPT.ColumnGrand Then lPT = lPT - 1
    If lLO <> lPT Then oLO.Resize oLO.Range.Resize(lPT)


    'Clear any old data outside of oLO if it has shrunk
    If lLO > lPT Then oLO.Range.Offset(oLO.Range.Rows.Count).Resize(lLO - lPT).ClearContents

End Sub

很酷的是,只要数据透视表更新,代码就会自动调整计算表的大小,并且您在数据透视表上进行过滤也会触发这些更新。因此,如果你只过滤几个rego号码,那么你看到的是: enter image description here

答案 1 :(得分:1)

您在问题中提到了SQL,所以我认为您可能对使用SQL的VBA解决方案感兴趣:

'Assumes your data is on a sheet called "DataSheet", and you want the answers stored starting in cell A2 of a sheet called "Results")

Sub test()
    Dim objConnection           As ADODB.Connection
    Dim objRecordset            As ADODB.Recordset

    Set objConnection = New ADODB.Connection
    Set objRecordset = New ADODB.Recordset

    objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                     "Data Source=" & ThisWorkbook.FullName & ";" & _
                                     "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    objConnection.Open

    sqlcommand = "SELECT LAST([Record ID]), " & _
                        "[Reg No], " & _
                        "LAST([Priority Level]), " & _
                        "LAST([Make]), " & _
                        "LAST([Current Stage]) " & _
                        "FROM [DataSheet$] GROUP BY [Reg No]"
    objRecordset.Open sqlcommand, objConnection, adOpenStatic, adLockOptimistic, adCmdText
    Sheets("Results").Range("A2").CopyFromRecordset objRecordset
End Sub

要使用它,您需要包含对&#34; Microsoft ActiveX Data Objects 6.1 Library&#34;的引用。和&#34; Microsoft ActiveX数据对象Recordset 6.0库&#34;在你的VBA项目中。 (至少,他们是我选择的那些。)