VBA根据单元格差异插入空行

时间:2016-11-08 15:16:51

标签: excel vba excel-vba

我有这种格式的数据: Excel Data

我想根据B列和C列中值之间的差异添加一个空白行。

我已经找到了一段很好的代码而且效果很好。

Dim i, itotalrows As Integer
Dim strRange As String

itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row


Do While i <= itotalrows
    i = i + 1
    strRange = "B" & i
    strRange2 = "B" & i + 1
    If Range(strRange).Text <> Range(strRange2).Text Then
        Rows(i + 1).Insert
        itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If

Loop

但这只检查了B列的差异。我为C列添加了相同的循环,但最后我得到了几行空行。我做的代码:

Dim i, itotalrows As Integer
Dim strRange As String

Dim n, itotalrowsc As Integer
Dim strRangec As String

itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row
itotalrowsc = ActiveSheet.Range("C65536").End(xlUp).Offset(1, 0).Row

Do While i <= itotalrows
    i = i + 1
    strRange = "B" & i
    strRange2 = "B" & i + 1
    If Range(strRange).Text <> Range(strRange2).Text Then
        Rows(i + 1).Insert
        itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If

Loop

Do While n <= itotalrowsc
    n = n + 1
    strRange = "C" & i
    strRange2 = "C" & i + 1
    If Range(strRangec).Text <> Range(strRangec2).Text Then
        Rows(i + 1).Insert
        itotalrows = ActiveSheet.Range("C65536").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If

Loop

它可能会考虑第一个循环中的空行和基于该行的另一个空白行。

我如何调整代码,使其像这样:

If B[i] <> B[i+1] or C[i] <> C[i+1] Then Insert BlankRow

1 个答案:

答案 0 :(得分:0)

Hm,而不是添加第二个块,尝试添加For循环。 (注意我也将strRange更改为Range):

Sub t()
Dim i, itotalrows As Integer
Dim strRange As Range, strRange2 As Range
Dim col As Long

itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row

For col = 2 To 3
Do While i <= itotalrows
    i = i + 1
    Set strRange = Cells(i, col)
    Set strRange2 = Cells(i + 1, col)
    If strRange.Text <> strRange2.Text Then
        Rows(i + 1).EntireRow.Insert
        ' What's itotalrows doing?
        itotalrows = ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).Row
        i = i + 1
    End If
Loop
Next col
End Sub