|
Sub Check_B_Column()
Dim i As Integer
Dim FR As Range, MyR As Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
For i = Worksheets.Count To 1 Step -1
With Worksheets(i)
.Range("B:B").Replace " ", ""
If Application.Count(.Range("B:B")) = 0 Then
.Delete
Else
Set FR = .Range("A:F").Find("*", , xlValues, , , xlPrevious)
Set MyR = .Range("B1:B" & FR.Row)
If Application.Count(MyR) < MyR.Count Then
MyR.SpecialCells(4).EntireRow.Delete xlShiftUp
End If
Set FR = Nothing: Set MyR = Nothing
End If
End With
Next i
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
で、どうかな ?
|
|