VBA Excel，如果相同的值然后从另一列计算值，则循环遍历2列

Question

我有以下问题需要帮助：

我有这张桌子

A------------B------------C-----------开始日期---结束日期

Phase1.1--Phase1----分析师--1/1/2018--1/3/2019

Phase1.1--Phase1----分析师--1/2/2018--1/4/2020

Phase1.1--Phase1----分析师--1/3/2018--1/5/2019

Phase1.1--Phase1----经理--1/2/2018--1/7/2019

Phase1.1--Phase1----经理--1/1/2018--1/5/2019

Phase1.1--Phase2----分析师--1/1/2018--1/3/2019

……..

我想遍历此表并检查 B 列的值是否相同（重复）移动到 C 列，对于 C 列中的相同值，计算“开始日期”列的最小值和“结束日期”列的最大值日期”。
然后在新的excel表中写入行 因此，对于 C 列中的每个条目，我都有一行，其开始日期和结束日期取决于 B 列。 此外，A 列始终相同，应该复制而不是更改。 结果应该是这样的：

A--------B------------C------------开始日期-----结束日期

Phase1.1---Phase1----分析师----1/1/2018--1/4/2020

Phase1.1---Phase1----Manager----1/1/2018-----1/7/2019

Phase1.1---Phase2----分析师----1/1/2018--1/3/2019

…………..

这就是我的real data 的样子：

感谢您的支持

Answer 1

这是通过 VBA 实现的一种方法。

Sub rowLoop()
Dim lRow As Long, lRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim startDate As String, endDate As String

Set ws1 = Sheets("Data") 'set this to be the worksheet with data
Set ws2 = Sheets("Results") 'set this to the worksheet you want the results to go

lRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row 'find last used row

ws2.Range("B2:C" & lRow).Value = ws1.Range("B2:C" & lRow).Value 'copy over Column B values
ws2.Range("$B$2:$C$" & lRow).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'remove duplicates


lRow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row 'find last used row
For i = 2 To lRow2 'loop through rows to determin start and end date
    ws2.Range("A" & i).Value = i - 1

    For j = 2 To lRow
        If ws2.Range("B" & i).Value = ws1.Range("B" & j).Value And ws2.Range("C" & i).Value = ws1.Range("C" & j).Value Then
            If startDate = "" Then
                startDate = ws1.Range("D" & j).Value
            Else
                If ws1.Range("D" & j).Value < startDate Then
                    startDate = ws1.Range("D" & j).Value
                End If
            End If

            If endDate = "" Then
                endDate = ws1.Range("E" & j).Value
            Else
                If ws1.Range("E" & j).Value > endDate Then
                    endDate = ws1.Range("E" & j).Value
                End If
            End If
        End If
    Next j
    ws2.Range("D" & i).Value = startDate
    ws2.Range("E" & i).Value = endDate
    startDate = ""
    endDate = ""
Next i

End Sub