visual basic对文件夹下的excel执行批量删除行操作

如图操作，在excel中添加 visual basic 工具

新建一个excel 在开发工具 那里选择 插入 按钮操作

 

附上一下代码

Sub hz()
Dim i As Long
Dim f, ff As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ff = fso.getfolder(Range("B1").Value)
For Each f In ff.Files
    If f.Name <> ThisWorkbook.Name And Left(f.Name, 2) <> "~$" Then
        Workbooks.Open Filename:=Range("B1").Value & f.Name
        With Workbooks(f.Name).ActiveSheet
           Rem .Columns("A:A").Insert shift:=xlToRight
           Rem  For i = 3 To .Cells(Rows.Count, "B").End(xlUp).Row
           Rem     .Cells(i, "A").Value = .Cells(i, "B") & .Cells(i, "C")
           Rem Next
          
            For i = 1 To 31 Step 1
            .Rows(1 & ":" & 1).Select
            Selection.Delete shift:=xlUp
            Next

            For i = 106 To 4287 Step 106
            Rem lcu的个数
            .Rows(i & ":" & i).Select
            Selection.Delete shift:=xlUp
            i = i - 1
            Next

            .Rows(1 & ":" & 1).Select
            Selection.Delete shift:=xlUp
            For i = 105 To 4287 Step 105
            .Rows(i & ":" & i).Select
            Selection.Delete shift:=xlUp
            i = i - 1
            Next

            For i = 4161 To 4190 Step 1
            .Rows(4161 & ":" & 4161).Select
            Selection.Delete shift:=xlUp
            Next

        End With
        Workbooks(f.Name).Close True
    End If
Next f
Set fso = Nothing
End Sub
Sub GETDIR()
Dim pathA$
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then Exit Sub
    pathA = .SelectedItems(1) & "\"
End With
Range("B1").Value = pathA
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$B$1" Then
    Application.EnableEvents = False
    Range("B1").Value = IIf(Right(Range("B1").Value, 1) <> "\", Range("B1").Value & "\", Range("B1").Value)
    Application.EnableEvents = True
End If
End Sub

 

 

学习 http://club.excelhome.net/thread-698236-1-1.html