时间戳

首页 > 解决方案 > 读取 A 列，根据模式插入行

excel - 读取 A 列，根据模式插入行

问题描述

我在 A 列中有如下所示的数据：

A
B
A
B
B
B
A
B
A
B

几点：

  1. 所有 A 必须至少有一个 B。所有 A 都有 B，所有 B 都有 A。（这是一个会计系统 - 它需要这个）。
  2. 任何 A 都可以有尽可能多的 B。
  3. 在每个 AB[n] 组合之后，我们需要一个 C。
  4. C 必须是插入的行。不允许排序和过滤（A、B 和 C 是不被字母字符替换的变量，如这里所示）。
  5. 代码不应在第一个 A 上方插入 C。

预期输出：

A
B
C
A
B
B
B
C
A
B
C
A
B
C

我已经看过这个：Excel：每 x 行插入新行，内容根据模式 但该模式基于已知的 27 行插入。这在我的问题中没有保证的模式。

标签： excelvba

解决方案

尝试

Sub test()
    Dim vDB, vR()
    Dim A, B, C
    Dim i As Long, r As Long, n As Long

    A = "A"
    B = "B"
    C = "C"

    vDB = Range("a1").CurrentRegion
    r = UBound(vDB, 1)
    n = 1
    ReDim Preserve vR(1 To n)
    vR(1) = vDB(1, 1)
    For i = 2 To r

        If vDB(i - 1, 1) = B And vDB(i, 1) = A Then
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = C
        End If
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = vDB(i, 1)
    Next i
    If vR(n) = B Then
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = C
    End If
    Range("c1").CurrentRegion.Clear
    Range("c1").Resize(n, 1) = WorksheetFunction.Transpose(vR)
End Sub

如果你想要多列然后

Sub test2()
    Dim vDB, vR(), vS()
    Dim A, B, C
    Dim i As Long, r As Long, n As Long
    Dim col As Integer
    Dim Ws As Worksheet

    A = "A"
    B = "B"
    C = "C"

    vDB = Range("a1").CurrentRegion
    r = UBound(vDB, 1)
    col = UBound(vDB, 2)

    n = 1
    ReDim Preserve vR(1 To col, 1 To n)
    For j = 1 To col
        vR(j, n) = vDB(1, j)
    Next j

    For i = 2 To r

        If vDB(i - 1, 1) = B And vDB(i, 1) = A Then
            n = n + 1
            ReDim Preserve vR(1 To col, 1 To n)
            vR(1, n) = C
        End If
        n = n + 1
        ReDim Preserve vR(1 To col, 1 To n)
        For j = 1 To col
            vR(j, n) = vDB(i, j)
        Next j
    Next i
    If vR(1, n) = B Then
        n = n + 1
        ReDim Preserve vR(1 To col, 1 To n)
        vR(1, n) = C
    End If
    Set Ws = Sheets.Add 'Sheets("Result")
    With Ws
        .Range("a1").CurrentRegion.Clear
        .Range("a1").Resize(n, col) = WorksheetFunction.Transpose(vR)
    End With
End Sub

推荐阅读