VBA Excel, цикл через 2 столбца, если при одинаковом значении вычислить значение из другого столбца - PullRequest
Новая
       9

VBA Excel, цикл через 2 столбца, если при одинаковом значении вычислить значение из другого столбца

0 голосов
/ 04 сентября 2018

Хей, у меня следующая проблема, и мне нужна помощь:

У меня есть эта таблица

A ----------- B ---------- C ----------- Дата начала --- Дата окончания

Phase1.1 - Phase1 ---- Аналитик ----- 1/1/2018 ------ 1/3/2019

Phase1.1 - Phase1 ---- Аналитик ----- 1/2/2018 ------ 1/4 / * +1009-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 ----------- Дата начала ------ Дата окончания

* +1025 * Phase1.1 --- Phase1 ---- ---- Аналитик 1/1/2018 ----- 1/4 / * 1 026-2020 *

Phase1.1 --- Phase1 ---- менеджер ---- 1/1/2018 ----- 1/7/2019

* 1 029 * Phase1.1 --- Phase2 ---- ---- Аналитик 1/1/2018 ----- 1/3/2019

……… ..

Вот как мои реальные данные выглядят так:

Спасибо за вашу поддержку

1 Ответ

0 голосов
/ 04 сентября 2018

Вот один из способов сделать это через 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
...