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

Question

干我有以下问题，需要帮助：

我有这张桌子

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

Phase1.1 - 1阶段---- -----分析师------ 2018年1月1日2019年1月3日

Phase1.1 - 1阶段---- -----分析师------ 2018年1月2日2020年1月4日

Phase1.1 - 1阶段---- -----分析师------ 2018年1月3日2019年1月5日

Phase1.1 - 1阶段---- -----经理------ 2018年1月2日2019年1月7日

Phase1.1 - 1阶段---- -----经理------ 2018年1月1日2019年1月5日

Phase1.1 - 阶段2 ---- -----分析师------ 2018年1月1日2019年1月3日

……..

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

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

Phase1.1 --- 1阶段---- ----分析师----- 2018年1月1日2020年1月4日

Phase1.1 --- 1阶段---- ----经理----- 2018年1月1日2019年1月7日

Phase1.1 --- 2阶段---- ----分析师----- 2018年1月1日2019年1月3日

………..

这就是我的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