嵌套循环Excel VBA - Shiftleft

Question

我正在尝试创建一个新程序。我导入了一个csv文件，并且需要清理数据。第一行具有正确的标题，但与列标签应分配的内容存在一些不匹配。

例如： 正确的行应该是：

A         B     C      D
bxxxxxxx1 1994  7890   main

不正确的行例如：

bxxxxxxx1 bxxxxxxx2 1994 1995 7890 7891  main main
bxxxxxxx1 bxxxxxxx2 bxxxxxxx3 bxxxxxxx4 1994 1995 1996 1997 7890 7891 7890 7891 main main main main
bxxxxxxx1 bxxxxxxx2 bxxxxxxx3 1994 1995 1996 7890 7891 7892 main main main
bxxxxxxx1....bxxxxxxxn 1994....yearn...7890...789n...main1....mainn

因此，不正确的行会多次提供b值，然后是各自的值，这会使所有具有多个b值的行偏移。所以我想删除bxxxxxxx2,1995,7891和第二个主要内容，保留其余内容（将所有内容向左移动以与列标题对齐）

我目前的代码：

Sub bibcheck()
    Dim Cel As Range
    Dim n As Integer
    bibfound = 0

    For i = 3 To 9
        n = 0
        For j = 2 To 9
            Set Cel = Cells(i, j)

            If Cel Like "b*#" Or Cel Like "b*?" Then
                n = n + 1
                '  MsgBox n  :'to verify record is found
                Cel = ""    'Clear the bib record found


            'Insert new code
            'Use each n created per row to create a new loop for shifting to the  left
            'skip a value, then use n again to delete that many cells to the right, continuously shifting blanks to the left.

            Else  
            End If 
        Next
    Next
End Sub

Answer 1

这会做你所问的：

Sub bibcheck()
Dim ws As Worksheet
Dim lastrow As Long
Dim lastclm As Long
Dim i As Long
Dim j As Long
Dim oArr(1 To 4) As Variant
Dim t As Integer

Set ws = ThisWorkbook.ActiveSheet

With ws
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 3 To lastrow
        lastclm = .Cells(i, .Columns.Count).End(xlToLeft).Column
        j = Application.WorksheetFunction.CountIf(.Range(.Cells(i, 1), .Cells(i, lastclm)), "b*")
        t = 1
        For j = 1 To lastclm Step j
            oArr(t) = .Cells(i, j).Value
            t = t + 1
        Next j
        .Range(.Cells(i, 1), .Cells(i, lastclm)).ClearContents
        .Range(.Cells(i, 1), .Cells(i, 4)).Value = oArr
    Next i
End With

End Sub

在：

后：