归纳与总结，以备自查！

ctp_119

1. Sub 提取到工作表()
   
2. Dim dic As Object
   
3. Dim rng As Range
   
4. Dim i As Integer, y As Integer
   
5. Dim j As Integer
   
6. Dim bm As String
   
7. On Error Resume Next
   
8. Set dic = CreateObject("scripting.dictionary")
   
9. For i = 2 To [c65536].End(xlUp).Row
   
10.     dic(Cells(i, 3).Value) = ""
    
11. Next i
    
12. t = dic.Keys
    
13. For j = 0 To dic.Count - 1
    
14. Worksheets.Add(, After:=Sheets(Sheets.Count)).Name = t(j)
    
15. Range("a1:g1") = Array("工号", "姓名", "部门", "籍贯", "出生年月", "民族", "性别")
    
16. Next j
    
17. For Each rng In Sheet1.Range("c2:c" & Sheet1.[c65536].End(xlUp).Row)
    
18.     bm = rng.Value
    
19.     y = Sheets(bm).[a65536].End(xlUp).Row + 1
    
20.     rng.Offset(, -2).Resize(1, 7).Copy Sheets(bm).Cells(y, 1)
    
21. Next
    
22. End Sub
    

复制代码

ctp_119

1. Sub tobook()
   
2. Dim dic As Object
   
3. Dim i As Integer, j As Integer
   
4. Dim t As Variant
   
5. Dim wb As Workbook
   
6. Dim tb As Workbook
   
7. Dim pt As String
   
8. Dim ys As Worksheet
   
9. Dim sht As Worksheet
   
10. Set dic = CreateObject("scripting.dictionary")
    
11. r = [c65536].End(xlUp).Row
    
12. Set tb = ThisWorkbook
    
13. Set ys = ActiveSheet
    
14. pt = ThisWorkbook.Path
    
15. For i = 2 To r
    
16.     dic(Cells(i, 3).Value) = ""
    
17. Next i
    
18. t = dic.Keys
    
19. For j = 0 To dic.Count - 1
    
20.     Set wb = Workbooks.Add
    
21.     Set sht = ActiveSheet
    
22.     sht.Range("a1:g1") = Array("工号", "姓名", "部门", "籍贯", "出生年月", "民族", "性别")
    
23.     For i = 2 To r
    
24.         If ys.Cells(i, 3).Value = t(j) Then
    
25.             ys.Cells(i, 3).Offset(, -2).Resize(1, 7).Copy sht.Range("a65536").End(xlUp).Offset(1, 0)
    
26.         End If
    
27.     Next i
    
28.     wb.SaveAs Filename:=pt & "" & t(j)
    
29.     wb.Close
    
30. Next j
    
31. End Sub
    

复制代码

ctp_119

具体在附件中……

sunny_8848

多谢版主分享，总算找到读取工作表数据的简便方法

linyh1742595842

感谢版主分享，收藏下来慢慢研究。

鄂龙蒙

收藏学习了,谢谢!!!

ctp_119

程序法分类汇总：

1. Sub 按钮1_Click()
   
2. Dim dic As Object
   
3. Dim i As Integer, a As Integer, j As Integer
   
4. Dim k As Variant
   
5. Dim t As Variant
   
6. Set dic = CreateObject("scripting.dictionary")
   
7. Application.ScreenUpdating = False
   
8. Range("J2:M100").ClearContents
   
9. arr = Range("C2:F" & [C65536].End(xlUp).Row)
   
10. For i = 1 To UBound(arr)
    
11. dic(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) = dic(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) + arr(i, 4)
    
12. Next i
    
13. k = dic.keys
    
14. t = dic.items
    
15. ReDim brr(1 To 3, 1 To dic.Count)
    
16. For a = 1 To 3
    
17. For j = 1 To dic.Count
    
18. brr(a, j) = Split(k(j - 1), "|")(a - 1)
    
19. Next j
    
20. Next a
    
21. Range("j2").Resize(dic.Count, 3) = Application.WorksheetFunction.Transpose(brr)
    
22. Range("m2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(t)
    
23. Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

ctp_119

分类汇总，请看附件
分类汇总.zip (15.8 KB, 下载次数: 51)

2015-6-18 14:20 上传

点击文件名下载附件

lwl123007

@ctp_119  大师 请问能用Excel查询某日的 现汇买入价吗

高山雪原

感谢分享！谢谢总结！