[已解决]分类保存的问题，求助！！！望老师帮忙！！！谢谢~！

N7120

图片说明：
压缩包： 根据批号分区保存.rar (225.07 KB, 下载次数: 13)

2017-8-14 22:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2017-8-15 16:39

1. Private Sub CommandButton2_Click()    '保存
   
2.     Dim 批号
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sh In Worksheets
   
5.         d(sh.Name) = ""
   
6.     Next
   
7.     Set lv = ListView1
   
8.     For a = 1 To lv.ListItems.Count
   
9.         Set itm = lv.ListItems(a)
   
10.         批号 = Left(itm.SubItems(1), 2)
    
11.         If Not d.exists(批号) Then
    
12.             Sheets.Add after:=Sheets(Sheets.Count)
    
13.             ActiveSheet.Name = 批号
    
14.             Sheets(1).[a1:d1].Copy Sheets(批号).[a1]
    
15.         End If
    
16.         Sheets(1).Activate
    
17.         With Sheets(批号)
    
18.             i = .[a65536].End(3).Row + 1
    
19.             .Cells(i, 1) = itm.Text
    
20.             .Cells(i, 2) = itm.SubItems(1)
    
21.             .Cells(i, 3) = itm.SubItems(2)
    
22.             .Cells(i, 4) = itm.SubItems(3)
    
23.         End With
    
24.     Next a
    
25. End Sub

复制代码

跳转到最佳答案楼层

chart888

打开出错了

qqyyh

根据批号分区保存.rar (227.16 KB, 下载次数: 7)

2017-8-15 08:46 上传

点击文件名下载附件

yonhe

Sub 按批次分表保存()
For Each c In Sheet1.Range("b2:b" & [b60000].End(xlUp).Row)
nm = CStr(Left(c, 2))
Rows(c.Row).Copy Sheets(nm).Rows(Sheets(nm).[ A60000].End(xlUp).Row + 1)
Next c
End Sub
试试

N7120

yonhe 发表于 2017-8-15 11:51
Sub 按批次分表保存()
For Each c In Sheet1.Range("b2:b" & .End(xlUp).Row)
nm = CStr(Left(c, 2))

老师！您的代码有效的达到了分类保存的目的！谢谢您的帮助！但是我想知道
如何从【ListView1ListItems(A).SubItems(1)】中判断出数据类型，然后分别保存至【FY、XS表】里面。

yonhe

这个没研究过

N7120

yonhe 发表于 2017-8-15 14:41
这个没研究过

老师认识一些坛里的高手吗？
帮我请他们出来帮帮忙~！！！
谢谢啦！

grf1973

1. Private Sub CommandButton2_Click()    '保存
   
2.     Dim 批号
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sh In Worksheets
   
5.         d(sh.Name) = ""
   
6.     Next
   
7.     Set lv = ListView1
   
8.     For a = 1 To lv.ListItems.Count
   
9.         Set itm = lv.ListItems(a)
   
10.         批号 = Left(itm.SubItems(1), 2)
    
11.         If Not d.exists(批号) Then
    
12.             Sheets.Add after:=Sheets(Sheets.Count)
    
13.             ActiveSheet.Name = 批号
    
14.             Sheets(1).[a1:d1].Copy Sheets(批号).[a1]
    
15.         End If
    
16.         Sheets(1).Activate
    
17.         With Sheets(批号)
    
18.             i = .[a65536].End(3).Row + 1
    
19.             .Cells(i, 1) = itm.Text
    
20.             .Cells(i, 2) = itm.SubItems(1)
    
21.             .Cells(i, 3) = itm.SubItems(2)
    
22.             .Cells(i, 4) = itm.SubItems(3)
    
23.         End With
    
24.     Next a
    
25. End Sub

复制代码

02761752696

谢谢     分享  

N7120

grf1973 发表于 2017-8-15 16:39

老师！请帮忙把你刚给的代码
再加上1个判断，，，谢谢！
http://www.excelpx.com/thread-432802-1-1.html