Блог

Я «унаследовал» этот код от предыдущего коллеги в моей компании, и мне нужно его пересмотреть. Я не на том уровне программирования, чтобы понимать некоторые строки.

Код прямо сейчас работает. Он сравнивает два листа с одинаковыми заголовками и идентичной информацией о столбцах A / B / C. Все остальные ячейки имеют # s и могут изменяться.

1. Лист 1 / Начало по сравнению с листом 2 / Текущий
2. перечисляет значение каждого столбца с каждого листа рядом с каждым другим и
3. вычисляет% отклонения.
таким образом, каждый блок в таблице результатов имеет 3 столбца на идентичный столбец.

Однако в предыдущем коде использовалась таблица результатов с предварительно названными заголовками, и только после столбца 12 он будет использовать все заголовки, которые названы в исходных листах. Прямо сейчас столбцы представляют собой простые именованные столбцы 1,2,3 и т.д.

Я пытаюсь внести в это два дополнения:

1. добавьте вычисление столбца, в котором вычисляется разница значений (текущее происхождение). Столбец будет называться отклонением #. Я уже добавил условие ElseIf в код, но оно не вычисляется, и дополнительный столбец отображается только в конце таблицы, но не для каждого блока.

2. и я хотел бы, чтобы в таблице результатов использовались те же заголовки, начиная с столбца Идентификатор полосы движения, регион происхождения и т. Д. Из исходных листов, Как это происходит сейчас, начиная со столбца 12. (пример ниже; начиная со случайного 1)

это код:

 Sub Changes()
Dim x, y, z, Hdrs, i As Long, ii As Long, iii As Long
x = Original.UsedRange
y = Current.UsedRange
ReDim z(1 To UBound(x, 1) - 1, 1 To UBound(x, 2) * 3 - 6)
ReDim Hdrs(1 To UBound(z, 2) - 11)
x(1, 2) = "Origin Region": x(1, 3) = "Origin Country"

For i = 2 To UBound(x, 1)
    For ii = 1 To 3
        z(i - 1, ii) = x(i, ii)
    Next
Next
For i = 2 To UBound(x, 1)
    iii = 1
    For ii = 4 To UBound(x, 2)
        iii = iii   3
        z(i - 1, iii) = x(i, ii): z(i - 1, iii   1) = y(i, ii)
        If x(i, ii) = 0 Or IsEmpty(x(i, ii)) Then
            z(i - 1, iii   2) = "New Entry"
         ElseIf x(i, ii) <> 0 Then
            z(i - 1, iii   2) = Format(y(i, ii) / x(i, ii) - 1, "0%")
         ElseIf x(i, ii) <> 0 Then
            z(i - 1, iii   3) = Format(y(i, ii) - x(i, ii) - 1, "0")
        End If
    Next
Next
ii = -2
For i = 7 To UBound(x, 2)
    ii = ii   3
    Hdrs(ii) = x(1, i) amp; " Original"
    Hdrs(ii   1) = x(1, i) amp; " Current"
    Hdrs(ii   2) = x(1, i) amp; " Deviation %"
    Hdrs(ii   3) = x(1, i) amp; " Deviation #"
Next
Application.ScreenUpdating = 0
With Result.ListObjects(1)
    On Error Resume Next
    .DataBodyRange.Delete
    On Error GoTo 0
    .Parent.Columns(13).Resize(, 50).Delete
    For i = .ListColumns.Count To 13 Step -1
        .ListColumns(i).Delete
    Next
    .Parent.[a3].Resize(UBound(z, 1), UBound(z, 2)) = z
    .Parent.[m2].Resize(, UBound(Hdrs)) = Hdrs
    
    'You will probably have to adjust the ColumnWidth value in the next line
    'to suit your actual extra headers
    .Parent.[m2].Resize(, UBound(Hdrs)).ColumnWidth = 10

End With
 

Конец подраздела

Пример исходного листа:

 Sub Changes()
Dim x, y, z, Hdrs, i As Long, ii As Long, iii As Long
x = Original.UsedRange
y = Current.UsedRange
ReDim z(1 To UBound(x, 1) - 1, 1 To UBound(x, 2) * 4 - 9)
ReDim Hdrs(1 To UBound(z, 2))

For i = 2 To UBound(x, 1)
    For ii = 1 To 3
        z(i - 1, ii) = x(i, ii)
    Next
Next
For i = 2 To UBound(x, 1)
    iii = 0
    For ii = 4 To UBound(x, 2)
        iii = iii   4
        z(i - 1, iii) = x(i, ii): z(i - 1, iii   1) = y(i, ii)
        If x(i, ii) = 0 Or IsEmpty(x(i, ii)) Then
            z(i - 1, iii   2) = "New Entry"
            If iii = UBound(z, 2) - 3 Then Exit For
         Else
            z(i - 1, iii   2) = Format(z(i - 1, iii   1) - z(i - 1, iii), "0.00")
            z(i - 1, iii   3) = Format(z(i - 1, iii   1) / z(i - 1, iii) - 1, "0%")
        End If
    Next
Next
For i = 1 To 3
    Hdrs(i) = x(1, i)
Next
ii = 0
For i = 4 To UBound(x, 2)
    ii = ii   4
    Hdrs(ii) = x(1, i) amp; " Original"
    Hdrs(ii   1) = x(1, i) amp; " Current"
    Hdrs(ii   2) = x(1, i) amp; " Deviation #"
    Hdrs(ii   3) = x(1, i) amp; " Deviation %"
Next
Application.ScreenUpdating = 0
With DataChanges
    With .ListObjects(1)
        On Error Resume Next
        .DataBodyRange.Offset(1).Delete
        On Error GoTo 0
        .Parent.Columns(4).Resize(, 100).Delete
        .Resize .HeaderRowRange.Columns(1).Resize(UBound(z, 1)   1, UBound(z, 2))
        .DataBodyRange = z
        .HeaderRowRange = Hdrs
        For i = 4 To UBound(Hdrs) - 3 Step 8
            .HeaderRowRange.Columns(i).Resize(, 4).Interior.Color = RGB(84, 130, 53)
        Next
        With .DataBodyRange
            For i = 4 To UBound(Hdrs) - 3 Step 8
                For ii = 1 To .Rows.Count Step 2
                    .Columns(i).Rows(ii).Resize(, 4).Interior.Color = RGB(169, 208, 142)
                Next
                For ii = 2 To .Rows.Count - 1 Step 2
                    .Columns(i).Rows(ii).Resize(, 4).Interior.Color = RGB(198, 224, 180)
                Next
            Next
        End With
    End With
    .Columns(4).Resize(, UBound(Hdrs)   1).ColumnWidth = 12
End With
    
 

Конец подраздела