Excel VBA -이 매크로가 모든 것을 삭제하는 이유

Question

이 매크로에 대한 도움이 필요합니다. 나는 꽤 열악하게 형식화 된 통합 문서를 가지고 있는데, 나는 그것을 열 때마다 일관되게있다. 무엇보다도 목표는 B 열에 비어 있지 않은 셀을 찾고 그 아래에있는 전체 2 행과 그 채워진 B 셀 각각 위에있는 첫 번째 행을 삭제하는 것입니다.

코드에서 첫 번째 루프는 내가 원하는 방식으로 작동하지만 두 번째 루프는 채워진 B 셀의 첫 번째 인스턴스에서만 작동하는 것처럼 보이지만 500 이상 셀 가치가있는 데이터.

누군가가 왜 이런 일이 일어 났는지 설명해 주실 수 있습니까? 그리고 둘 다 루프로 결합하는 방법을 찾을 수 있다면 좋을 것입니다.

Sub test() 

Dim currentSht As Worksheet 
Dim startCell As Range 
Dim lastRow As Long, lastCol As Long 
Dim colNames As Variant 
Dim i As Integer, j As Integer 

Set currentSht = ActiveWorkbook.Sheets(1) 
Set startCell = currentSht.Range("A1") 
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row 
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column 

For i = lastRow To 1 Step -1 
If currentSht.Cells(i, "B").Value <> "" Then 
    currentSht.Cells(i, "B").Offset(1).EntireRow.Delete 
End If 
Next i 

Range("D3").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Selection.Delete Shift:=xlUp 

currentSht.Rows("1:1").EntireRow.Delete 
currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete 
currentSht.Range("A:D").Columns.AutoFit 

For j = lastRow To 2 Step -1 
If currentSht.Cells(j, "B").Value <> "" Then 
    currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete 
End If 
Next j 
End Sub 

때문에 라인 above 발견 된 값의 삭제에 당신

Answer 1

두 번째 루프는 모든 내용이 삭제 감사, 값이 최대 이동됩니다 다른 삭제를 트리거, 다시 찾을 수있다. 이 문제를 해결하려면, 가장 빠른 방법은 수정 J하여 다음 두 줄을 건너 뛸 것 :

For j = lastRow To 2 Step -1 
    If currentSht.Cells(j, "B").Value <> "" Then 
     currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete 
     j = j - 2 
    End If 
Next j 

당신이 위에서 아래로 또는 그 반대의 경우도 마찬가지 반복하는 경우 정말별로 중요하지 않습니다. 유일한 차이점은 B 열에 서로 가까이에 두 개의 항목이있는 경우입니다. 이 경우 검색 순서에 따라 삭제되는 순서가 결정됩니다. 그러나 삭제는 실제로 원하는 것입니까? 어쩌면 .Clear 행을 지우지 않고 내용을 삭제할 수 있습니다.

편집 : 여기에 조금

Sub test() 
    Dim currentSht As Worksheet 
    Dim startCell As Range 
    Dim lastRow As Long, lastCol As Long 
    Dim colNames As Variant 
    Dim i As Integer, j As Integer 

    Set currentSht = ActiveWorkbook.Sheets(1) 
    Set startCell = currentSht.Range("A1") 
    lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row 
    lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column 

    For i = lastRow To 1 Step -1 
     If currentSht.Cells(i, "B").value <> "" Then 
      'reference the row directly 
      currentSht.Rows(i + 1).Delete 
     End If 
    Next i 

    'Do not use selection if you can avoid it 
    Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp 

    currentSht.Rows(1).Delete 
    currentSht.Range("C:D, F:G, I:K").Delete 
    currentSht.Range("A:D").Columns.AutoFit 

    For j = lastRow To 2 Step -1 
     If currentSht.Cells(j, "B").value <> "" Then 
      currentSht.Rows(j - 1).Delete 
      currentSht.Rows(j - 2).Delete 
      j = j - 2 
     End If 
    Next j 
End Sub 

매크로의 동작 때문에 루프 사이에 일어나는 삭제로 변경됩니다 루프를 결합하려는 경우

을 청소 새로운 코드입니다.