중첩 루프 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, 2 주, 나머지를 유지를 제거하려면 내가 현재 가지고 :

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 

하기 전에 :

후 0

: 데이터 *의