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 代码,则可以尝试使用 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)),"")
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
并向下填充!
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
MINIFS
和MAXIFS
就足够了。 - Vitalizzare