zoukankan      html  css  js  c++  java
  • Excel 一个工作表进行按行数拆分

    1. 如下Excel表,总共有120多行数据,如何将以50行数据为一个工作表进行拆分
    Sub ZheFenSheet()
    
        Dim r, c, i, WJhangshu, WJshu, bt As Long
        r = Range("A" & Rows.Count).End(xlUp).Row
        b = InputBox("请输入分表行数")
        If IsNumeric(b) Then
               WJhangshu = Int(b)
            Else
                MsgBox "输入错误", vbOKOnly, "错误"
                End
        End If
        c = Cells(1, Columns.Count).End(xlToLeft).Column
        bt = 1 '标题行数
        'WJhangshu = 50 '每个文件的行数
        WJshu = IIf(r - bt Mod WJhangshu, Int((r - bt) / WJhangshu), Int((r - bt) / WJhangshu) + 1)
        
        '------
        Set fs = CreateObject("Scripting.FileSystemObject") '
        
        For i = 0 To WJshu
            Workbooks.Add
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & Format(i + 1, String(Len(WJshu), 0)) & "." & fs.GetExtensionname(ThisWorkbook.FullName)   '扩展名
            Application.DisplayAlerts = True
            ThisWorkbook.ActiveSheet.Range("A1").Resize(bt, c).Copy ActiveSheet.Range("A1")
            ThisWorkbook.ActiveSheet.Range("A" & bt + i * WJhangshu + 1).Resize(WJhangshu, c).Copy _
            ActiveSheet.Range("A" & bt + 1)
            ActiveWorkbook.Close True
        Next
    
    
    End Sub

    2.  如下Excel表  按照 XX 列 工作表进行拆分

    ' 如下Excel表  按照 XX 列 工作表进行拆分
    
    ' 第三列 任务负责人 ,关键字
    ' ******************************************
    ' -----------------------------------------
    '  Str = Arr(i, 1)   '第一列 任务负责人 ,关键字
     
     
     Sub 如何将一个Excel工作表的数据拆分成多个工作表()
        Dim Arr, Rng As Range, Sht As Worksheet, Dic As Object
        Dim k, t, Str As String, i As Long, lc As Long
        
        Application.ScreenUpdating = False '关闭屏幕更新
        Arr = Range("A1").CurrentRegion.Value
        
        lc = UBound(Arr, 2) '求取最后一列的列号
        
        Set Rng = Rows(1) '标题行
        Set Dic = CreateObject("Scripting.Dictionary") '创建字典
        
        For i = 2 To UBound(Arr)
            
            '-----------------------------------------
            Str = Arr(i, 1) '第一列 拆分 订单号,关键字
            '-----------------------------------------
            
            If Not Dic.Exists(Str) Then '如果字典没有关键字
                Set Dic(Str) = Cells(i, 1).Resize(, lc) '把当前行装入到字典中
            Else '否则(字典中存在关键字)
                Set Dic(Str) = Union(Dic(Str), Cells(i, 1).Resize(, lc)) '把行连合起来
            End If
            
        Next
        
        k = Dic.Keys '字典关键字集合
        t = Dic.Items '字典项目集合
        On Error Resume Next
        With Sheets
            For i = 0 To Dic.Count - 1 '循环关键字的个数
                Set Sht = .Item(k(i)) '给变量赋值(工作表名为关键字)
                If Sht Is Nothing Then '该工作表不存在则插入一个空工作表
                    .Add(After:=.Item(.Count)).Name = k(i) '新建的工作表将置于所有工作表之后,并命名为关键字
                    Set Sht = ActiveSheet '活动工作表给变量
                Else '否则
                    Sht.Cells.Clear '清除工作中所有内容和格式
                End If
                Rng.Copy Sht.Range("A1") '把标题写入第一行
                t(i).Copy Sht.Range("A2") '写入其他内容
                Sht.Cells.EntireColumn.AutoFit '自动调整全工作表单元格的列宽
                Set Sht = Nothing '变量处于初始状态
            Next
        End With
        Sheets(1).Activate '第1个工作表处于激活状态
        Application.ScreenUpdating = True '打开屏幕更新
    End Sub
  • 相关阅读:
    Javascript FP-ramdajs
    微信小程序开发
    SPA for HTML5
    One Liners to Impress Your Friends
    Sass (Syntactically Awesome StyleSheets)
    iOS App Icon Template 5.0
    React Native Life Cycle and Communication
    Meteor framework
    RESTful Mongodb
    Server-sent Events
  • 原文地址:https://www.cnblogs.com/m0488/p/7998757.html
Copyright © 2011-2022 走看看