按表格A列的内容拆分成多个单独的工作簿

zcb412

A列有3个卡号，怎么拆分成以卡号命名的3个工作簿

cjjhpc

1.zip (18.68 KB, 下载次数: 12)

2021-5-10 22:46 上传

点击文件名下载附件

娱乐部长

我只懂python
import xlwings as xw
filepath='D:\\360安全浏览器下载\\按列拆分成工作薄\\'
app=xw.App(visible=False,add_book=False)
wb=app.books.open(filepath+'1.xlsx')
ws=wb.sheets[0]
data=ws.range(ws.used_range).value
d={}
for row in data[1:]:
   if row[0] not in d:
       d[row[0]]=[row]
   else:
       d[row[0]]+=[row]
for x,y in d.items():
    wbk=app.books.add()
    sht=wbk.sheets[0]
    sht.range('a1').value=data[0]
    sht.range('a2').options(expand='table').value=y
    sht.autofit(axis='c')
    wbk.save(filepath+x+'.xlsx')
    wbk.close()
wb.close()
app.quit()

zcb412

运行时出现“应用程序定义或对象定义错误怎么回事？

lsc900707

1. Sub gj23w98()
   
2.     Set rng = Range("a1:e1")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     arr = [a1].CurrentRegion
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     For i = 2 To UBound(arr): c = UBound(arr, 2)
   
8.          If Not d.exists(arr(i, 1)) Then
   
9.                 Set d(arr(i, 1)) = Cells(i, 1).Resize(1, c)
   
10.             Else
    
11.                 Set d(arr(i, 1)) = Union(d(arr(i, 1)), Cells(i, 1).Resize(1, c))
    
12.          End If
    
13.     Next
    
14.     k = d.keys
    
15.     t = d.items
    
16.     For i = 0 To d.Count - 1
    
17.         Set wb = Workbooks.Add
    
18.         With wb.Sheets(1)
    
19.             rng.Copy .[a1]: t(i).Copy .[a2]
    
20.             For j = 1 To UBound(arr, 2)
    
21.                .Columns(j).ColumnWidth = ThisWorkbook.ActiveSheet.Columns(j).ColumnWidth
    
22.             Next
    
23.         End With
    
24.         wb.SaveAs Filename:=ThisWorkbook.Path & "" & k(i)
    
25.         wb.Close
    
26.     Next
    
27.     Application.DisplayAlerts = True
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK!"
    
30. End Sub

复制代码

lsc900707

代码在审核中，先测试附件：

zcb412

lsc900707 发表于 2021-5-16 17:51
代码在审核中，先测试附件：

运用到其它表格，如更多的行和业，哪些参数需要更改？请指教

lsc900707

zcb412 发表于 2021-5-16 20:15
运用到其它表格，如更多的行和业，哪些参数需要更改？请指教

自行测试看看。

zx13500333

可以用现成的工具，《按列另存》
http://club.excelhome.net/thread-1575475-1-1.html

RexxarHuang

lsc900707 发表于 2021-5-16 17:51
代码在审核中，先测试附件：

老师，如果表头不是从A1开始，A4开始，前三行的内容都要复制到每个表去，怎么改代码