如何比较不同行中的单元格，如果下部单元格不相同，则如何右插入？

Question

如果两者不同，如何比较两行中的单元格并使下单元格值与上单元格值匹配？ 这是一些我正在使用的相同数据，并且希望在代码运行后能看到这些数据。

之前：

[ID_GLOBAL], [ID_UNIQUE], [ID_REAL], [ID_1], [ID_2], [GAS_ADJ], [OBJ_ADJ]
[ID_GLOBAL], [ID_UNIQUE], [ID_REAL], [GAS_ADJ], [OBJ_ADJ]

后：

[ID_GLOBAL], [ID_UNIQUE], [ID_REAL], [ID_1], [ID_2], [GAS_ADJ], [OBJ_ADJ]
[ID_GLOBAL], [ID_UNIQUE], [ID_REAL], NULL AS [ID_1], NULL AS [ID_2], [GAS_ADJ], [OBJ_ADJ]   

我认为代码基本上看起来像这样，但是我没有使正确的插入权限工作。

Sub CompareCellsDiffRows()
Dim bothrows  As Range, i As Integer

Set bothrows = Selection

With bothrows
    For i = 1 To .Columns.Count
        If Not StrComp(.Cells(1, i), .Cells(2, i), vbBinaryCompare) = 0 Then
            ' magic happens here
        End If
    Next i

End With

End Sub

您可能已经猜到了，我正在处理几个表中的数百个字段，并试图将所有内容合并在一起，因此所有这些字段名称都必须以正确的顺序进行匹配。

谢谢。

Answer 1

按照您的示例，我假设第一行将始终是完整的。

Sub CompareRowDifferences()

Dim sht As Worksheet
Dim i, LastColumn As Long

Set sht = ThisWorkbook.Worksheets("Transposed Fields")
LastColumn = sht.Cells.SpecialCells(xlLastCell).Column

With sht
    For i = 1 To LastColumn
        If StrComp(.Cells(1, i), .Cells(2, i), vbBinaryCompare) <> 0 Then
            .Cells(2, i).Insert Shift:=xlToRight
            .Cells(2, i).Value2 = "NULL AS " & .Cells(1, i).Value2
        End If
    Next i
End With

End Sub

希望能帮助到你

关于第二个问题（如果未排序），并始终假设第一行是规则...

Sub CompareRowDifferences()

Dim sht As Worksheet
Dim i, j, LastColumn As Long

Set sht = ThisWorkbook.Worksheets("Transposed Fields")
LastColumn = sht.Cells.SpecialCells(xlLastCell).Column
j = 0

With sht
    For i = 1 To LastColumn
        Test = Application.WorksheetFunction.CountIf(Range _
          (Cells(2, i), Cells(2, LastColumn + j)), .Cells(1, i).Value2)
        If Test >= 1 Then
            .Cells(2, i).Insert Shift:=xlToRight
            .Cells(2, i).Value2 = .Cells(1, i).Value2
        Else
            .Cells(2, i).Insert Shift:=xlToRight
            .Cells(2, i).Value2 = "NULL AS " & .Cells(1, i).Value2
        End If
        j = j + 1
    Next i
    Range(Cells(2, LastColumn), Cells(2, LastColumn + j)).ClearContents
End With

End Sub

Answer 2

此过程标识并使用具有更多字段（即无空单元格）的行，并将其用作“模型”以更新另一行，而不管字段在另一行中的位置。

Sub Headers_Comparison(rInput As Range)
Dim aOut As Variant, aSrc As Variant, aTrg As Variant
Dim bMatch As Byte, bRow As Byte, b As Byte


    With WorksheetFunction

        Rem Validate Fields in Rows
        If .CountA(rInput.Rows(1)) > .CountA(rInput.Rows(2)) Then
            bRow = 2
            aSrc = .Transpose(.Transpose(rInput.Rows(1).Value2))
            aTrg = .Transpose(.Transpose(rInput.Rows(2).Value2))

        Else
            bRow = 1
            aSrc = .Transpose(.Transpose(rInput.Rows(2).Value2))
            aTrg = .Transpose(.Transpose(rInput.Rows(1).Value2))

        End If

        aOut = aTrg
        For b = 1 To UBound(aSrc)
            bMatch = 0
            On Error Resume Next
            bMatch = .Match(aSrc(b), aTrg, 0)
            On Error GoTo 0
            aOut(b) = IIf(bMatch > 0, vbNullString, "NULL AS ") & aSrc(b)

    Next: End With

    rInput.Rows(bRow).Value = aOut

    End Sub

应该以这种方式调用：

Call Headers_Comparison(rSel)    'update with required range

Answer 3

我想我只是想通了！

Sub CompareRowDifferences()

Dim i As Integer
Dim sht As Worksheet
Dim LastColumn As Long

Set sht = ThisWorkbook.Worksheets("Transposed Fields")
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column

For i = 1 To LastColumn
    If Not StrComp(sht.Cells(1, i), sht.Cells(2, i), vbBinaryCompare) = 0 Then
        ' magic happens here
        Set Rng = sht.Cells(2, i)
        Rng.Insert Shift:=xlToRight
        sht.Cells(2, i).Value = "NULL AS " & sht.Cells(1, i).Value

    End If
Next i

End Sub

这似乎有效。 虽然，这是一个非常简单的解决方案。 我知道，如果更改下排的名称顺序，将会更加复杂。 这仅起作用，因为第2行中的名称与第1行中的名称相匹配，名称很少。 我希望看到与第1行名称相比，如果第2行名称的顺序改变了，代码将是什么样子。