使用 vba 筛选和更新 excel 中的列
Filter and update columns in excel with vba
我有四列：姓名、代码、已雇用和已解雇。
代码列中的值是唯一的。
一年中可以多次雇用和解雇某人，但我只需要第一次雇用某人和最后一次解雇某人。
我可以使用 vba 筛选和更新这些列吗？
我有的是A到D列的值，我要的是I到L列的值。
因此，如果您不知道如何编写 VBA 代码，那么您可以尝试使用 Excel 公式，但是对于以下公式，您肯定需要访问O365 或 O365 Insiders Beta 版
• 在单元格 F2 中使用公式得到 Unique Name & Codes,
=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()函数创建custom,reusable函数并引用它们由friendly name、LAMBDA()函数在名称管理器中使用定义的名称[=117] =] 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 等等，因此，替代方案如下所示，
• 单元格 F2
中使用的公式
=IFERROR(INDEX(A:A,MATCH(0,COUNTIF($F:F1,A:A),0)),"")
以上公式，是一个数组公式，需要根据你的Excel版本按CTRL+SHIFT+ENTER，
• 单元格 G2
中使用的公式
=IF($F2="","",VLOOKUP($F2,$A:$D,2,0))
• 单元格 H2 中使用的公式 --> 适用于 Excel 2019 年及以上
=MINIFS(C:C,$A:$A,$F2,$B:$B,$G2)
如果不使用上述任何一个版本，
=MIN(IF(($F2=$A:$A)*($G2=$B:$B),$C:$C,""))
是数组公式，需要按CTRL+SHIFT+ENTER往下填！
• 单元格 I2 中使用的公式 --> 适用于 Excel 2019 年及以上
=MAXIFS(D:D,$A:$A,$F2,$B:$B,$G2)
如果不使用上述任何一个版本，
=MAX(IF(($F2=$A:$A)*($G2=$B:$B),$D:$D,""))
是数组公式，需要按CTRL+SHIFT+ENTER往下填！
使用字典的最大值和最小值是唯一的
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
如果您有 Office 365，则可以使用其他答案之一中概述的公式来执行此操作。
这也可以使用 Power Query 完成，在 Windows Excel 2010+ 和 Excel 365（Windows 或 Mac）
使用 Power Query
- Select 数据中的某个单元格 Table
Data => Get&Transform => from Table/Range 或 from within sheet- 当 PQ 编辑器打开时：
Home => Advanced Editor
- 记下第 2 行中的 Table 名称
- 粘贴下面的 M 代码代替您看到的内容
- 将第 2 行中的 Table 名称更改回最初生成的名称。
- 阅读评论并探索
Applied Steps 以了解算法
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"
我有四列：姓名、代码、已雇用和已解雇。 代码列中的值是唯一的。 一年中可以多次雇用和解雇某人，但我只需要第一次雇用某人和最后一次解雇某人。 我可以使用 vba 筛选和更新这些列吗？
我有的是A到D列的值，我要的是I到L列的值。
因此，如果您不知道如何编写 VBA 代码，那么您可以尝试使用 Excel 公式，但是对于以下公式，您肯定需要访问O365 或 O365 Insiders Beta 版
• 在单元格 F2 中使用公式得到 Unique Name & Codes,
=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()函数创建custom,reusable函数并引用它们由friendly name、LAMBDA()函数在名称管理器中使用定义的名称[=117] =] 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 等等，因此，替代方案如下所示，
• 单元格 F2
=IFERROR(INDEX(A:A,MATCH(0,COUNTIF($F:F1,A:A),0)),"")
以上公式，是一个数组公式，需要根据你的Excel版本按CTRL+SHIFT+ENTER，
• 单元格 G2
=IF($F2="","",VLOOKUP($F2,$A:$D,2,0))
• 单元格 H2 中使用的公式 --> 适用于 Excel 2019 年及以上
=MINIFS(C:C,$A:$A,$F2,$B:$B,$G2)
如果不使用上述任何一个版本，
=MIN(IF(($F2=$A:$A)*($G2=$B:$B),$C:$C,""))
是数组公式，需要按CTRL+SHIFT+ENTER往下填！
• 单元格 I2 中使用的公式 --> 适用于 Excel 2019 年及以上
=MAXIFS(D:D,$A:$A,$F2,$B:$B,$G2)
如果不使用上述任何一个版本，
=MAX(IF(($F2=$A:$A)*($G2=$B:$B),$D:$D,""))
是数组公式，需要按CTRL+SHIFT+ENTER往下填！
使用字典的最大值和最小值是唯一的
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
如果您有 Office 365，则可以使用其他答案之一中概述的公式来执行此操作。
这也可以使用 Power Query 完成，在 Windows Excel 2010+ 和 Excel 365（Windows 或 Mac）
使用 Power Query
- Select 数据中的某个单元格 Table
Data => Get&Transform => from Table/Range或from within sheet- 当 PQ 编辑器打开时：
Home => Advanced Editor - 记下第 2 行中的 Table 名称
- 粘贴下面的 M 代码代替您看到的内容
- 将第 2 行中的 Table 名称更改回最初生成的名称。
- 阅读评论并探索
Applied Steps以了解算法
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"