如果Statement比较不同行但相同列的字符串

时间:2018-04-11 18:19:48

标签: excel vba office365

我试图根据特定情况将我的Excel电子表格中的2行合并为1行。

我想让我的vba代码确定第2行中的字符串是否是第3行中的字符串。

如果它们相等,我想将第3行的所有第3行复制到第Q列,然后继续比较第3行,第4行,第4行和第5行等的字符串值到电子表格的最后一行。

我试图修改我在Stack Overflow上找到的代码,但仍无法让我的宏运行。对此的任何帮助将不胜感激。

这里是我在Stack Overflow中发现的类似情况的链接,当时我正在研究如何创建我的VBA代码,但我无法让示例代码为我工作。不知道为什么。 vba - excel - if value = next row value then copy another value

这是我正在使用的Excel工作表的一部分。我确实需要修改电子表格中的信息,以免粘贴太宽。

Member Data spreadsheet

1 个答案:

答案 0 :(得分:0)

类似的东西:

 Public Sub ArrangeData()
    Dim i As Long, unionRng As Range, lastRow As Long, counter As Long
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Data")         'change as appropriate
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:G" & lastRow).Sort Key1:=.Range("G2:G" & lastRow), Order1:=xlAscending, Header:=xlYes ' 'Sort to ensure in order (and blanks will be at end

        For i = 3 To .Range("G1").End(xlDown).Row + 1
            If .Cells(i, "G") = .Cells(i - 1, "G") Then
                counter = counter + 1
                .Cells(i, "A").Resize(1, 6).Copy .Cells(i - counter, .Cells(i - counter, .Columns.Count).End(xlToLeft).Column + 1)
            Else
                counter = 0
            End If
        Next i

        For i = 3 To .Range("G1").End(xlDown).Row + 1
            If IsEmpty(.Cells(i, "H")) Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, .Cells(i, "H"))
                Else
                    Set unionRng = .Cells(i, "H")
                End If
            End If
        Next i
        If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub

<强>之前:

Before

<强>后:

After