• 20190118_xlVBA多表合并


    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
    

      

  • 相关阅读:
    MySQL binlog 组提交与 XA(两阶段提交)
    mydumper 安装报错处理
    安装 gcc-c++ 时报错和原有 gcc 版本冲突
    mysql / mysqld_safe / mysqld 常见错误处理
    Linux 内核日志——dmesg
    Java中的Atomic包
    JAVA NIO中的Channels和Buffers
    字节流InputStream/OutputStream
    字符输出流Writer简要概括
    字符输入流Reader简要概括
  • 原文地址:https://www.cnblogs.com/nextseven/p/10289911.html
Copyright © 2020-2023  润新知