使用VBA筛选并更新Excel中的列

Question

我有四列：名称，编号，入职和离职。 编号列中的值是唯一的。 一个人在一年中可以多次入职和离职，但我只需要第一次入职和最后一次离职。 我能用vba过滤和更新这些列吗？ 我拥有的是从A到D列中的值。我想要的是从I到L列中的值。

- ZeMatteis

---

不需要编写代码，MINIFS和MAXIFS就足够了。 - Vitalizzare

Answer 1

如果你有Office 365，你可以按照其他答案中概述的公式进行操作。

也可以使用Power Query完成，适用于Windows Excel 2010+和Excel 365（Windows或Mac）。

使用Power Query方法如下：

- 选择数据表中的某个单元格 - 选择 "数据=>获取和转换=>从表/范围获取" 或 "从工作表内获取" - 当 PQ 编辑器打开时：选择 "开始=>高级编辑器" - 注意第二行的表名称 - 将下面的 M 代码粘贴到看到的内容中 - 将第二行的表名改回最初生成的表名。 - 阅读注释并探索“应用步骤”以了解算法。

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"

- Ron Rosenfeld

Answer 2

因此，如果您不知道如何编写 VBA 代码，则可以尝试使用 Excel 公式，但对于以下公式，您 一定 需要访问 O365 或 O365 Insiders Beta 版本

• 在单元格 F2 中使用的公式可获取唯一名称和代码，

=UNIQUE(A2:B20)

• 单元格 H2 中使用的公式

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

• 单元格 I2 中使用的公式

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

---

使用 LET() 函数可以使读者更容易阅读和理解，

• 公式用于单元格 F9

=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)))

使用 LAMBDA() 函数创建一个自定义、可重用的函数，并使用友好名称引用它们，LAMBDA() 函数在名称管理器中使用定义名称作为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等版本，因此下面提供了替代方案，如下所示：

• 在单元格F2中使用的公式

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

上述公式是一个数组公式，根据你的Excel版本需要按下CTRL+SHIFT+ENTER进行计算。

• 单元格G2中使用的公式。

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

• 单元格中使用的公式为 H2 --> 适用于 Excel 2019 及以上版本

=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 + ENTER 并向下填充！

• 单元格 I2 中使用的公式 --> 适用于 Excel 2019 及以上版本

=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 + ENTER 并向下填充！

- Mayukh Bhattacharya

Answer 3

使用字典实现最大值和最小值的唯一性

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

- VBasic2008