精华内容
下载资源
问答
  • 2、excel表格保留一行标题行,并把第一数据填写为拆分项(文件拆分时将第一的内容进行归类合并为一个文件),整个表格不要合并单元格; 3、在打开的EXCEL工作表名称上点右键选择查看代码; 4、选择菜单栏:...
  • Option Explicit Sub main() Dim colNo As Integer, sht As Worksheet, lastRow As Long, i As Long, flag As Boolean colNo = InputBox("col no:") Excel.Application.DisplayAlerts = Fals...
    Option Explicit
    
    Sub main()
        Dim colNo As Integer, sht As Worksheet, lastRow As Long, i As Long, flag As Boolean
        colNo = InputBox("col no:")
            
        Excel.Application.DisplayAlerts = False
        For Each sht In Sheets
            If sht.Name <> Sheet1.Name Then sht.Delete
        Next
        Excel.Application.DisplayAlerts = True
        
        lastRow = Sheet1.Range("A1000000").End(xlUp).Row
        
        For i = 2 To lastRow
            flag = False
            For Each sht In Sheets
                If sht.Name = Sheet1.Cells(i, colNo) Then
                    flag = True
                    Exit For
                End If
            Next
            
            If Not flag Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = Sheet1.Cells(i, colNo).Value
                Sheet1.UsedRange.AutoFilter field:=colNo, Criteria1:=Sheet1.Cells(i, colNo).Value
                Sheet1.UsedRange.Copy Sheets(Sheets.Count).[A1]
            End If
        Next
        
        Sheet1.UsedRange.AutoFilter
        
    End Sub
    

     

    Option Explicit
    
    Sub main()
        Dim lineNo As Integer, keys, dict, i As Integer
        lineNo = InputBox("input line no")
        
        Set dict = GetItems(Sheet1, lineNo)
        keys = dict.keys
        Call DeleteSheets
        
        For i = 0 To dict.Count - 1
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = keys(i)
            
            Sheet1.UsedRange.AutoFilter field:=lineNo, Criteria1:=keys(i)
            Sheet1.UsedRange.Copy Sheets(Sheets.Count).Range("A1")
            
        Next
        
        Sheet1.UsedRange.AutoFilter
        
    End Sub
    
    Function GetItems(sht As Worksheet, lineNo As Integer)
        Dim d As Object, i As Integer
        Set d = CreateObject("Scripting.Dictionary")
        For i = 2 To sht.Range("A65536").End(xlUp).Row
            If Not d.exists(sht.Cells(i, lineNo).Value) Then
                 d.Add Key:=sht.Cells(i, lineNo).Value, Item:=sht.Cells(i, lineNo).Value
            End If
        Next
        Set GetItems = d
    End Function
    
    
    Sub DeleteSheets()
        Dim i As Integer
        Excel.Application.DisplayAlerts = False
        For i = Sheets.Count To 2 Step -1
            Sheets(i).Delete
        Next
        Excel.Application.DisplayAlerts = True
    End Sub
    

     

    展开全文
  • 首先,将需要拆分的sheet命名为“明细”,接下来运行此代码,提示操作即可。 在这里插入代码片 Sub chaifen() '定义变量类型 Dim sht, sh1, sh2 As Worksheet Dim k, i, j As Integer Dim irow As Integer Dim col...

    首先,将需要拆分的sheet命名为“明细”,接下来运行此代码,按提示操作即可。

    在这里插入代码片
    Sub chaifen()
    '定义变量类型
    Dim sht, sh1, sh2 As Worksheet
    Dim k, i, j As Integer
    Dim irow As Integer
    Dim col As Integer
    Dim str As String
    
    '程序开始是要求输入按哪一列拆分数据
    col = InputBox("请输入你要按哪一列拆分数据")
    
    '获取所选择的文件夹路径
      Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    
      With fileDlg
    
          If .Show = -1 Then
    
               For Each fld In .SelectedItems
    
                    str = fld
    
               Next fld
    
          End If
    
      End With
    
    
    
    
    
    Application.ScreenUpdating = False '防止屏幕一直闪动
    
    
    '开始时先删除无意义的表,只留下需要拆分的sheet
    Application.DisplayAlerts = False '防止程序运行中弹出警告
    
    If Sheets.Count > 1 Then
        For Each sht1 In Sheets
            If sht1.Name <> "明细" Then
                sht1.Delete
            End If
        Next
    End If
    
    Application.DisplayAlerts = True
    
    '拆分明细这张sheet
    irow = Sheet1.Range("a1048576").End(xlUp).Row '用于计算sheet1一共有几行
    For i = 2 To irow
        k = 0
        For Each sht In Sheets
            If sht.Name = Sheet1.Cells(i, col) Then
                k = 1
            End If
        Next
        
        If k = 0 Then
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Sheet1.Cells(i, col)
        End If
    Next
    '拷贝数据到“明细”后面的sheet2,sheet3,sheet4....中
    For j = 2 To Sheets.Count
        Sheet1.Range("a1:s" & irow).AutoFilter Field:=col, Criteria1:=Sheets(j).Name
        Sheet1.Range("a1:s" & irow).Copy Sheets(j).Range("a1")
    Next
    
    Sheet1.Range("a1:s" & irow).AutoFilter '取消筛选
    Sheet1.Select
    
    
    
    
    '将其中的sheets拆分为多个Excel文件
    
    For Each sht2 In Sheets
        If sht2.Name <> "明细" Then
            sht2.Copy
            ActiveWorkbook.SaveAs Filename:=str & "\" & sht2.Name & ".xlsx"
            ActiveWorkbook.Close
        End If
    Next
    
    Application.ScreenUpdating = True
    MsgBox "已处理完毕"
    
    
    End Sub
        
    
    
    
    
    
    
    展开全文
  • VBA 按照某一进行筛选拆分数据,拆分成多个表或多个Sheet,检查重复生成新的Sheet,删除除本表外的所有表
  • 例如:一个综合性的excel报表,第1行C是省份,而且此综合性报表有多个sheet要拆分,想要实现拆分所有sheet,并省份合并成一个excel表,比如所有辽宁省的数据合并成一个excel文件以不同的sheet体现。用此脚本即可...
  • excel如某一列拆分成多个工作表(支持多列),或多个Excel文件,或某几列拆分成多个文件。 使用这个在线工具,无需vba,不用复杂的透视表,地址:http://www.excelfb.com/,点击:(指定列)拆分成多个表 ...

      excel如按某一列拆分成多个工作表(支持多列),或多个Excel文件,或按某几列拆分成多个文件。

     

      使用这个在线工具,无需vba,不用复杂的透视表,地址:http://www.excelfb.com/ ,点击: 拆分表--》(按指定列)拆分成多个表

     操作如下图:(如果是多列,例如A列和B列,在按第几列填入A,B  用‘,’隔开A和B)

     

       

    展开全文
  • 用python拆分excel表格程序及优化需求VBA失败代码性能调优Python最终代码总结 需求 要处理几个七八百兆大的csv文件,需求是把它里面每个站的数据拆分成单独的excel文件。 网上有现成的方方格子软件,处理...

    用python按某列值拆分excel表格程序及优化

    需求

    • 要处理几个七八百兆大的csv文件,需求是把它里面每个站的数据拆分成单独的excel文件。
    • 网上有现成的方方格子软件,处理起来发现挺慢,要花5天多时间
    • 站的数量有上千个,用excel2010打开一个csv也显示不全,不知道如果导入access或者单机的mysql,oracle里执行下会不会很快,试了下access,版本是2010的,导入csv文件表头处理的就有问题,看来用access不是很理想。
    • 先想到了用excel自带的VBA来处理下,自己没学过,只是通过搜索来自编程序,结果卡在了永远只能复制第一行到新表里,复制其他行就是不往下走,不知道如何解决,有高手看到了请帮忙看看此问题已解决,使用Application.CutCopyMode = False就可以搞定,不过貌似执行起来速度挺慢。
    • 于是改用python来处理,百度了很多案例学习了下,改成了真正能实现的代码,跑了一个470MB的文件居然花了约8小时,加了个调试为了看进度,结果跑700MB的文件居然花了24小时居然只处理了十分之一数据,这才拿一部分数据试了下加调试信息和不加的差异,发现果然很大,有的语句尽管没开开关,但只要放在循环里就很耗时,必须注销掉。
    • 优化后估算700MB的文件只要跑约9小时。

    VBA代码

    Sub ExtractBySite()
        Dim Wb1, Wb2, Wb3 As Workbook
        Dim cPath$, siteName$, newFilePath$
        cPath = ThisWorkbook.Path & "\"  '获取本文件所在路径
        Set Wb1 = ThisWorkbook  '如果放在本文件中执行则直接用这个读取站点信息
        '提示选择数据文件
        MsgBox ("请选择要拆分的数据文件")
        FilePathFull = Application.GetOpenFilename("所有文件 (*.*), *.*", 0, "选定文件", , False)
        If FilePathFull <> "False" Then
            Filename = Right(FilePathFull, Len(FilePathFull) - InStrRev(FilePathFull, "\"))
            FilePath = Left(FilePathFull, Len(FilePathFull) - Len(Filename))
            FileHead = Left(Filename, InStrRev(Filename, "-") - 1)
            'MsgBox "FilePath:" & FilePath & vbCrLf & "FileName:" & Filename & vbCrLf & "Filehead:" & FileHead
        End If
        Set Wb2 = Workbooks.Open(FilePathFull)
        Application.ScreenUpdating = False  '关闭屏闪,加速处理
        
        '逐个获取sheet(FileHead)第i个站点的名字,去FileHead数据文件中读取站点数据,保存到以站点命名的新文件中
        For i = 2 To Wb1.Sheets(FileHead).UsedRange.Rows.Count
            siteName = Wb1.Sheets(FileHead).Cells(i, 2).Value
            '循环读WB2数据到WB3
            a = 2
            For j = 2 To Wb2.Sheets(1).UsedRange.Rows.Count
                If Wb2.Sheets(1).Cells(j, 1) = siteName Then
                    If a = 2 Then
                        '创建新表WB3
                        Set Wb3 = Workbooks.Add()
                        '复制表头到新表WB3
                        Wb2.Sheets(1).Rows(1).Copy
                        Wb3.Sheets(1).Cells(1, 1).PasteSpecial
                        Application.CutCopyMode = False  '取消选择
                        '复制数据行
                        Wb2.Sheets(1).Cells(j, 1).EntireRow.Copy Destination:=Wb3.Sheets(1).Cells(a, 1)
                    Else
                        Wb2.Sheets(1).Cells(j, 1).EntireRow.Copy Destination:=Wb3.Sheets(1).Cells(a, 1)
                    End If
                    Application.CutCopyMode = False  '取消选择,才能选中复制下一行
                    a = a + 1
                End If
            Next j
            '保存数据到新表WB3文件
            If a > 2 Then
                newFilePath = cPath & siteName & ".xlsx"
                Wb3.SaveAs (newFilePath)
                Wb3.Close (False)
            End If
        Next i
        
        Application.ScreenUpdating = True
        MsgBox "拆分完毕!", vbInformation, "提示"
    End Sub
    

    性能调优

    python:

    1. 放弃使用读字典表再按字典表遍历数据表的做法。这样将遍历n*m次,在字典过多,数据量过大时,耗时严重放大。
    2. 改为只遍历一遍数据表,边读边分拣边形成字典表,数据也分拣为字典里的key种类数。这种方法也可以处理数据表里数据是乱序,未按站点排序的情况。不知道先对上千万行的数据排序,再遍历是不是比这个方法更慢
    3. 按其他前辈讲的,将循环中用到的list改成dict,果然会减少一半时间
    4. 把循环中的print改成循环到n次再打印会明显提升执行速度
    5. 在打印data.iloc[[i],:]的循环中尽管关闭了myPrint 1 的开关,但依然严重影响速度,注销这句会极大缩短执行时间

    Python最终代码

    # -*- coding: utf-8 noBOM-*-
    """
    @用法:1. 修改 refColumname引号中的值为'被拆分文件'里要遵照拆分的字段名
           2. 输入'被分割文件'的路径+名称,不需要加引号。
           3. 会自动在要拆分文件的同目录下创建以文件名的‘—’前字符为名称的目录,并输出拆分的文件
    @Created on 2020/4/10
    @author: abraham
    """
    
    import pandas as pd
    import time
    import os
    from myDebug.myPrint import myPrint
    
    #打印调试信息开关
    DEBUG_LEVEL=0  #please refer to myDebug.myPrint
    
    
    def splitExcel(splitFilename:str, refColumname:str):
    	myPrint(1, "============Begin to split the file================")
    	starttime = time.time()
    	fileHead = ''.join(splitFilename.split('\\')[-1:]).split('-')[0]
    	filePath = "\\".join(splitFilename.split('\\')[:-1])+"\\"+fileHead+"\\"
    	if not os.path.exists(filePath):
    		os.makedirs(filePath)
    
    	myPrint(1, splitFilename, refColumname,splitFilename[-3:],filePath)
    	
    	if splitFilename[-3:] == "csv":
    		data = pd.read_csv(splitFilename)
    	else:
    		io = pd.io.excel.ExcelFile(splitFilename)
    		data = pd.read_excel(io,sheetname=1)  #多sheet下,放在io里读取速度要比这样读取快pd.read_excel(splitFilename)
    		io.close()
    
    	rows = data.shape[0]  #获取行数,不含表头; shape[1]获取列数
    	myPrint(DEBUG_LEVEL, "data rows:", rows)
    	
    	site_dict = {}
    	site_list = []
    	newFileDir_dict = {}
    
    	#遍历splitFilename,存成字典newFileDir_dict,把同一个站点的数据存在一个key值下的第二列的DataFrame里
    	for i in range(rows):
    		if i%10000==0:  #减少输出调试信息占用的时间,大幅缩短程序运行时间
    			myPrint(1, i, "of rows", rows, "run time:%s Seconds"%int(time.time()-starttime))
    		site_name = data[refColumname][i] #是从数据行开始,所以i不能从1开始
    		if site_name not in site_dict:  #转成dict可以把时间缩短一半
    			site_list.append(site_name)
    			site_dict = dict.fromkeys(site_list,True)  #用了这句可以把时间缩短一半
    			newFileDir_dict[site_name] = [filePath+"\\"+site_name+".xlsx", pd.DataFrame()]
    		newFileDir_dict[site_name][1] = newFileDir_dict[site_name][1].append(data.iloc[[i],:],ignore_index = True)
    		#即使开关为0也严重影响了运行速度,因此注销myPrint(DEBUG_LEVEL, "data.iloc[[i],:]:\n", data.iloc[[i],:]) #每一行数据都会打印出表头
    	myPrint(DEBUG_LEVEL, "newFileDir_dict:", newFileDir_dict, '\n', newFileDir_dict.items(), '\n', newFileDir_dict.keys())
    	
    	#按字典key值保存成excel文件
    	for site_name in newFileDir_dict.keys():
    		newFileDir = newFileDir_dict[site_name][0]
    		newFileDir_dict[site_name][1].to_excel(newFileDir, sheet_name=site_name, index = False, columns = data.columns.values)
    		myPrint(1, "Generate file: "+newFileDir)
    	myPrint(1, "============End of the split the file================")
    
    
    if __name__ == '__main__' :
    	print("====用法:")
    	print("====1.直接执行py程序的:请先修改文件中refColumname引号中的值为'被分割文件'里字段的名字")
    	print("====2.输入'被分割文件'的路径+名称,不需要加引号,可以使用复制粘贴,须右键点对话框边框")
    	print("====3.会自动在要拆分文件的同目录下创建以文件名的‘—’前字符为名称的目录,并输出拆分的文件\n")
    	splitFilename = input("请输入要拆分的文件路径及名称:") 
    	refColumname = input("请输入要按照哪个字段名拆分:") 
    	
    	splitExcel(splitFilename, refColumname)
    

    总结


    1. myPrint是参考网上的封装了print的一个模块,目的是增加记录时间的功能,并能通过开关控制是否打印日志。 ↩︎

    展开全文
  • 班级分表: 开发工具–>VB编辑器–>视图–>代码窗口–>粘贴下面代码 Sub cfgzb() Dim arr, d As Object, k, t, ... c = Application.InputBox("请输入拆分列号", , 1, , , , , 1) If c = 0 Then Ex...
  • 背景:业务给了一个大表格,里面几十万条数据,要拆分...Sub A区分内容并拆分到新表格() Dim i% arr = Sheets(1).[a1].CurrentRegion Set d = CreateObject("scripting.dictionary") For i = 2 To UBound(arr)
  • 如图示,该工作表为某公司销售记录,现需要将该表按照部门进行拆分,将不同部门的销售记录存放于不同的工作表中,该如何使用VBA实现? 出货日期 发票号码 部门 规格型号 单位 数量 单价 ...
  • 最近需要筛选Excel的数据 看到网上有大神做出来的Demo 但是在mac上...Sub 如何将一个Excel工作表的数据拆分成多个工作表() Dim Arr, Rng As Range, Sht As Worksheet, Dic As Object Dim k, t, Str As String, i A
  • 基本原理是定位到月度交易流水字段,并遍历每一行,调用Split()函数将字符串拆分成数组,并调用简单的交换排序确保月份降序排列,最后将每月交易流水填入新增的中。 使用方法:打开该宏文件,切换到目标excel...
  • 求助vba大神

    2020-04-04 19:18:05
    大神们,我是想写保留前5行,按列拆分数据为若干新工作簿,但是代码一直错了,可以帮忙 看一下吗? Sub 保留表头拆分数据为若干新工作簿()     Dim arr, d As Object, k, t, i&, lc%, rng As Range, c...
  • VBA学习

    2020-09-08 15:20:57
    A = Selection.Address '例如:A:A:A:B–A到B,$A1:1:1:C$3–区域range(“A1:... arr1 = Split(A, "3−−第一行到第三行IfA=""ThenExitSubarr1=Split(A,"") '按拆分,得到的结果装入数组arr1中Ifarr1(1)Like"∗:"Then
  • 使用Python进行Excel文件拆分

    千次阅读 2020-06-19 14:50:44
    运营的伙伴希望把这个表区域或门店拆分成单个的数据文件再给到相应的人,看上去并不复杂的一个需求,实现的方式有很多,可以手工筛选再拆分,可以用EXCEL做透视表,也可以用VBA写个脚本等等。(中小企业在成长到...
  • Excel VBA技巧实例手册

    2016-07-28 22:29:39
    第1篇 ExcelVBA基础 第1章 了解Excel宏 1.1 创建宏 技巧001显示“开发工具”选项卡 技巧002录制第一个宏 技巧003在VBE中创建宏 1.2 管理宏 技巧004运行宏 技巧005编辑宏 技巧006保存宏 技巧007设置宏的安全性 第2...
  • Excel VBA实用技巧大全 附书源码

    热门讨论 2010-10-08 18:59:24
    04085获取指定号单元格的标字母(之一) 04086获取指定号单元格的标字母(之二) 04087获取单元格区域的行号范围 04088获取单元格区域的号范围 04089获取单元格区域的标字母范围 04090获取数据区域的...
  • 自动生成VBA窗体菜单

    2010-08-16 15:23:46
    自动生成VBA窗体菜单 '*************************** '* 菜单类 * '*************************** Option Explicit Private WithEvents MenuBar_MenuItem As MSForms.Label '菜单项 Private WithEvents WorkForm As...
  • 使用VBA将Excel工作表分割成多个文件

    万次阅读 2015-11-04 12:02:08
    这里需要城市(即B数据)对表格进行拆分拆分出多个以城市名称命名的xlsx文件,每个xlsx文件都只包含当前城市的数据。  相关资料 之前没有接触过Excel相关的编程,也没有学习过VB语言,完全是摸着...
  • 的最大网格尺寸10000行和提高到32767行和。(对超大量数据的网格化是一个好消息, 比如高程数据体一般都是近亿的数据量) 2、使用了Tabbed(标签)窗口,在工作区顶部显示标签,打开的多个图形窗口,只需要...
  • excel 工具箱

    2012-01-22 15:04:34
    按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【小写金额转大写】:将小写金额批量转换成大写 【大写金额转小写...
  • Excel通用工具2.2

    2005-12-02 10:36:26
    7、同一工作表内单元格索引功能:当工作表很大时,可以使用本功能,以便在一张工作表内行或快速定位到指定的单元格<BR>??8、将选定区域内空白的单元格置零(财务专用)<BR>??9、将选定区域内有错误值的单元格置...
  • Excel百宝箱9.0无限制破解版

    热门讨论 2012-02-03 19:05:29
    按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【中英翻译】:将选区进行中英互译,如果选择英文则转换成中文;...
  • Excel百宝箱

    2012-10-27 17:09:21
    按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【中英翻译】:将选区进行中英互译,如果选择英文则转换成中文;...
  • Excel百宝箱8.0

    2011-06-07 21:32:17
    【生成系统图标】【获取内置命令】【修复Excel】【破解VBA密码】【删除空单元格】【转置选区】【按列倒置】【按列倒置】【字母大小写转换】【小写金额转大写】【大写金额转小写】【区域数据加密】【多区域复制】【按...
  • 按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【中英翻译】:将选区进行中英互译,如果选择英文则转换成...
  • 按列倒置】将选区中每列的数据倒序存放 【按行倒置】将选区中每行的数据倒序存放 【转置选区】将选区转置一个方向存放,即纵向转换成横向 【字母大小写转换】将选区的英文单词在大写与小写间切换,也可以首字母...
  • EXCEL百宝箱8.0终极版

    2011-11-05 16:48:02
    按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【小写金额转大写】:将小写金额批量转换成大写 【大写金额转小写...
  • 按列倒置】:将选区的数据横向倒置 【按列倒置】:将选区的数据纵向倒置 【字母大小写转换】:将选区的单词、字母在大写小写、首字母大写之间转换 【中英翻译】:将选区进行中英互译,如果选择英文则转换成中文;...

空空如也

空空如也

1 2 3 4
收藏数 75
精华内容 30
关键字:

vba按列拆分