根据单元格 ID（例如 A2、D15 等）找到相应的列 Header 和行 ID

Question

我有一个代码可以比较两个数据集（Sheet 1，Sheet 2）并在 Sheet 3 中列出方差。

我正在尝试添加三个额外的列，它们将进行简单的计算并从 Sheet 中提取 header/row 信息 2.

偏差计算：将更改后的值除以原始值。
列 Header 将在 E
行 ID 将在第 2 行（A 列）中找到 ID

样本数据sheet1

Sheet 2 使用不同的#s 看起来是一样的。

输出当前显示发现变异的单元格 ID、原始值和新值。黄色的列是我要添加的内容。

这是原代码：

Option Explicit

Sub ListChanges()
Dim x, y, z, i As Long, ii As Long

x = Original.Cells(1).CurrentRegion
y = Current.Cells(1).CurrentRegion
ReDim z(1 To 3, 1 To 1)

z(1, 1) = "Location": z(2, 1) = "Original Value": z(3, 1) = "Changed Value"
For i = 1 To UBound(y, 2)
    For ii = 2 To UBound(y, 1)
        If z(1, UBound(z, 2)) <> "" Then ReDim Preserve z(1 To 3, 1 To UBound(z, 2) + 1)
        If ii <= UBound(x, 1) Then

            If y(ii, i) <> x(ii, i) Then
                z(1, UBound(z, 2)) = Chr(64 + i) & ii
                z(2, UBound(z, 2)) = x(ii, i)
                z(3, UBound(z, 2)) = y(ii, i)
            End If
        Else
            z(1, UBound(z, 2)) = Chr(64 + i) & ii
            z(3, UBound(z, 2)) = y(ii, i)
        End If
    Next
Next
With Changes
    .Activate
    .Cells(1).CurrentRegion.Clear
    .[a1].Resize(UBound(z, 2), UBound(z, 1)) = Application.Transpose(z)
    With .Cells(1).CurrentRegion
        .HorizontalAlignment = xlCenter
        With Rows(1).Font
            .Size = 12
            .Bold = 1
        End With
        .Columns.AutoFit
    End With
End With

End Sub

我一直在查看不同的代码，但参考通常是一个单元格值，我在其中使用实际的单元格 ID 而不是它的值。

Answer 1

尝试这样的事情。假设行的排序可能不同，但列相同且顺序相同。

Sub ListChanges()

    Dim arrOrig, arrCurrent, delta, i As Long, ii As Long, r As Long, m
    Dim rngOrig As Range, rngCurrent As Range, id, col As Long, vO, vC
    
    Set rngOrig = Original.Cells(1).CurrentRegion
    Set rngCurrent = Current.Cells(1).CurrentRegion
    
    arrOrig = rngOrig.Value
    arrCurrent = rngCurrent.Value
    
    ReDim delta(1 To UBound(arrCurrent, 1) * (UBound(arrCurrent, 2)), 1 To 6) 'max possible size
    
    delta(1, 1) = "Location"
    delta(1, 2) = "Original Value"
    delta(1, 3) = "Changed Value"
    delta(1, 4) = "Deviation"
    delta(1, 5) = "Header"
    delta(1, 6) = "Row ID"
    r = 1 'row in delta array
    
    For i = 2 To UBound(arrCurrent, 1)
        id = arrCurrent(i, 1)
        'find the corresponding row
        m = Application.Match(id, rngOrig.Columns(1), 0)
        If Not IsError(m) Then
            For col = 2 To UBound(arrCurrent, 2)
                vO = arrOrig(m, col)
                vC = arrCurrent(i, col)
                If (Len(vC) > 0 Or Len(vO) > 0) And vC <> vO Then
                    r = r + 1
                    delta(r, 1) = rngCurrent.Cells(i, col).Address(False, False)
                    delta(r, 2) = vO
                    delta(r, 3) = vC
                    If Len(vO) > 0 And Len(vC) > 0 Then
                        If IsNumeric(vO) And IsNumeric(vC) Then
                            delta(r, 4) = vC / vO * 100 'eg
                        End If
                    End If
                    delta(r, 5) = arrCurrent(1, col) 'header
                    delta(r, 6) = arrCurrent(i, 1)   'id
                End If
            Next col
        Else
            'no id match, just record the cell address and the current id
            r = r + 1
            delta(r, 1) = rngCurrent.Cells(i, 1).Address(False, False)
            delta(r, 6) = id
        End If
     Next
    With Changes
        .Activate
        .Cells(1).CurrentRegion.Clear
        .[a1].Resize(r, UBound(delta, 2)) = delta '<< edited here
        With .Cells(1).CurrentRegion
            .HorizontalAlignment = xlCenter
            With Rows(1).Font
                .Size = 12
                .Bold = 1
            End With
            .Columns.AutoFit
        End With
    End With

End Sub

根据单元格 ID（例如 A2、D15 等）找到相应的列 Header 和行 ID

Locate Respective Column Header & Row ID based on Cell ID (e.g. A2, D15 etc)

excel

vba

formula

lookup-tables