nextseven
Public Sub simple()
    Set wb = ActiveWorkbook
    Set sht = ActiveSheet
    msg = MsgBox("程序准备清除活动工作表内容?按是确认,按否退出!", vbYesNo, "Tips")
    If msg = vbNo Then Exit Sub
    msg = MsgBox("请您确认是否对本文件做好了备份,宏运行之后不可恢复?按是确认,按否退出!", vbYesNo, "Tips")
    If msg = vbNo Then Exit Sub
    sht.Cells.Clear
    
    shtFilter = Application.InputBox("请输入工作表过滤字符(没有指定的话输入星号*)  : ", "InputBox", , , , , , 2)
    If shtFilter = False Then shtFilter = ""
    
    head = Application.InputBox("请输入表头行数", "InputBox", , , , , , 1)
    If head = False Then head = 0
    
    endFilter = Application.InputBox("请输入结束行字符(没有指定的话输入星号*) :", "InputBox", , , , , , 2)
    If endFilter = False Then endFilter = ""
    tail = Application.InputBox("请输入表尾行数", "InputBox", , , , , , 1)
    If tail = False Then tail = 0
    
    counter = 0
    For Each onesht In wb.Worksheets
        If onesht.Name Like "*" & shtFilter & "*" Then
            If onesht.Name <> sht.Name Then
                counter = counter + 1
                Debug.Print onesht.Name
                With onesht
                    If Application.WorksheetFunction.CountA(.Cells) > 0 Then
                        EndCol = 50 \' .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
                        
                        EndRow = .Cells.Find("*" & endFilter & "*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
                        If counter = 1 Then
                            Set scrRng = .Range(.Cells(1, "a"), .Cells(EndRow - tail, EndCol))
                            scrRng.Copy sht.Cells(1, 1)
                        Else
                            Set scrRng = .Range(.Cells(head + 1, 1), .Cells(EndRow - tail, EndCol))
                            With sht
                                nextRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
                                scrRng.Copy sht.Cells(nextRow, 1)
                            End With
                        End If
                    End If
                End With
            End If
        End If
    Next
End Sub

  

分类:

技术点:

相关文章:

  • 2022-12-23
  • 2021-11-19
  • 2021-12-30
  • 2021-04-02
  • 2021-08-08
  • 2022-01-04
  • 2021-12-20
  • 2022-12-23
猜你喜欢
  • 2021-12-12
  • 2021-12-12
  • 2021-10-08
  • 2022-03-10
相关资源
相似解决方案