使用VBA过滤和更新Excel中的列

Question

我有四列：姓名，代码，被雇用和射击。 代码列中的值是唯一的。 一年中可以雇用和开除几次，但我只需要第一次被录用，而只是最后一次被解雇。 我可以使用VBA过滤和更新这些列吗？

我所拥有的是从A到D的列中的值。我想要的是从i到l的列中的值

。 >

Answer 1

如果您有Office 365，则可以使用其他答案之一中概述的公式来执行此操作。

这也可以使用电源查询来完成，该电源查询可在Windows Excel 2010+和Excel 365（Windows或Mac）中使用，

以使用电源查询

• 选择数据表中的一些单元格
• data =＆gt;获取＆amp; transform =＆gt;从表/范围或从表格中
• 打开时： home =＆gt;高级编辑器
• 在第2行中的表格名称
• 粘贴下面的M代码，以代替您看到的
• 第2行中的表名称回到最初生成的内容。
• 阅读评论并探索应用步骤以了解算法

m代码

let

//Read in data
//   Change table name in next line to your actual table name
    Source = Excel.CurrentWorkbook(){[Name="EmplTbl"]}[Content],

//Set the column data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"NAME", type text}, {"CODE", type text}, {"HIRED", type date}, {"FIRED", type date}}),

//Group by Name and ID
//  Then aggregate by minimum HIRED and maximum FIRED to get results
    #"Grouped Rows" = Table.Group(#"Changed Type", {"CODE", "NAME"}, {
        {"Hired", each List.Min([HIRED]), type nullable date}, 
        {"Fired", each List.Max([FIRED]), type nullable date}
        })
in
    #"Grouped Rows"

Answer 2

使用词典与最大和最小的唯一

Sub CreateHireFireReport()
    
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "A1"
    Const uCol As Long = 2
    Const hCol As Long = 3
    Const fCol As Long = 4
    
    Const dName As String = "Sheet1"
    Const dFirstCellAddress As String = "I1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range(sFirstCellAddress).CurrentRegion
    If srg.Rows.Count < 2 Then Exit Sub ' no data or just headers
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim sData As Variant: sData = srg.Value
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim sr As Long
    
    For sr = 2 To srCount
        Key = sData(sr, uCol)
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                dict(Key) = Empty
            End If
        End If
    Next sr
    If dict.Count = 0 Then Exit Sub ' only blanks and error values
    
    Dim drCount As Long: drCount = dict.Count + 1
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
    Dim ddr As Long: ddr = 1
    
    Dim dr As Long
    Dim c As Long
    
    ' Write headers.
    For c = 1 To cCount
        dData(1, c) = sData(1, c)
    Next c
    
    ' Write data.
    For sr = 2 To srCount
        Key = sData(sr, uCol)
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                If dict(Key) = Empty Then
                    ddr = ddr + 1
                    dr = ddr
                    dict(Key) = ddr
                    For c = 1 To cCount
                        dData(dr, c) = sData(sr, c)
                    Next c
                Else
                    dr = dict(Key)
                    If IsDate(sData(sr, hCol)) Then
                        If IsDate(dData(dr, hCol)) Then
                            If sData(sr, hCol) < dData(dr, hCol) Then
                                dData(dr, hCol) = sData(sr, hCol)
                            End If
                        Else
                            dData(dr, hCol) = sData(sr, hCol)
                        End If
                    End If
                    If IsDate(sData(sr, fCol)) Then
                        If IsDate(dData(dr, fCol)) Then
                            If sData(sr, fCol) > dData(dr, fCol) Then
                                dData(dr, fCol) = sData(sr, fCol)
                            End If
                        Else
                            dData(dr, fCol) = sData(sr, fCol)
                        End If
                    End If
                End If
            End If
        End If
    Next sr
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    
    With dws.Range(dFirstCellAddress).Resize(, cCount)
        ' Format unique column as text.
        .Resize(drCount, 1).Offset(, uCol - 1).NumberFormat = "@"
        ' Write result.
        .Resize(drCount).Value = dData
        ' Clear below.
        .Resize(dws.Rows.Count - .Row - drCount + 1).Offset(drCount).Clear
        ' Apply other formatting.
        .Font.Bold = True ' headers
        .EntireColumn.AutoFit
    End With

    MsgBox "Hire-fire-report created.", vbInformation
    
End Sub

Answer 3

因此，如果您不知道如何编写 vba代码，那么您也可以尝试使用 excel formulas ，您肯定需要访问 o365 或 o365 o365内部人员beta版本

•cell f2 f2 < /code>获得 唯一名称 ＆amp; 代码 ，

=UNIQUE(A2:B20)

•在单元格> H2 中使用的公式

=MINIFS(C2:C20,A2:A20,F2:F6,B2:B20,G2:G6)

•cell i2

=MAXIFS(D2:D20,A2:A20,F2:F6,B2:B20,G2:G6)

---

使用 let（）更容易读取和 Leaws ，

Cell

=LET(u,UNIQUE(A2:A20),
c,UNIQUE(B2:B20),
CHOOSE({1,2,3,4},u,c,
MINIFS(C2:C20,A2:A20,u,B2:B20,c),
MAXIFS(D2:D20,A2:A20,u,B2:B20,c)))

---

•使用 f9 使用 lambda（）函数to ，•公式创建 自定义 ， 可重复使用 功能，并通过 友好名称 ， lambda（） name manager 中使用的功能 定义的名称 aS hirefire 带有语法在

=HireFire(array,header)

其中，

HireFire = LAMBDA(array,header,
VSTACK(TAKE(header,1,4),
LET(a,INDEX(array,,1),
b,INDEX(array,,2),
c,INDEX(array,,3),
d,INDEX(array,,4),
u,UNIQUE(a),
uc,UNIQUE(b),
HSTACK(u,uc,
MINIFS(c,a,u,b,uc),
MAXIFS(d,a,u,b,uc)))))(A2:D20,A1:D1)

•因此，在 f15 中使用的公式，

=HireFire(A2:D20,A1:D1)

---

由于您尚未提及excel版本，因此您可能正在使用 excel 2019 或 2016 代码>或 2013 因此，因此，如下所示的替代方案，

•cell f2 中使用的公式

=IFERROR(INDEX(A$2:A$20,MATCH(0,COUNTIF($F$1:F1,A$2:A$20),0)),"")

>上述公式，是一个数组公式，需要按 ctrl + shift + ENTER 基于您的Excel版本，

•cell g2 中使用的

=IF($F2="","",VLOOKUP($F2,$A$2:$D$20,2,0))

公式单元 H2 - ＆GT; 适用于Excel 2019＆amp;上面

=MINIFS(C$2:C$20,$A$2:$A$20,$F2,$B$2:$B$20,$G2)

如果不使用上述任何一个版本，则

=MIN(IF(($F2=$A$2:$A$20)*($G2=$B$2:$B$20),$C$2:$C$20,""))

其数组公式，因此需要按 ctrl + shift> shift> shift + enter 填写！

•单元格中使用的公式 i2 - ＆gt; 适用于Excel 2019＆amp;上面

=MAXIFS(D$2:D$20,$A$2:$A$20,$F2,$B$2:$B$20,$G2)

如果不使用上述任何一个版本，则

=MAX(IF(($F2=$A$2:$A$20)*($G2=$B$2:$B$20),$D$2:$D$20,""))

其数组公式，因此需要按 ctrl + shift> shift> shift + enter 填写！