Board logo

標題: [發問] 工作表資料分類另存工作表 [打印本頁]

作者: missbb    時間: 2024-9-15 15:29     標題: 工作表資料分類另存工作表

各位, 本人有一WORKBOOK內有資料, 需要在SORTING "地區" 和"組別" 後. 按"地區"另存新WORKSHEET, 並以"地區" 作為WORKSHEET名稱, 但下列CODE有問題, 求教問題所在:D
[attach]37887[/attach]
  1. Sub TSsheet2()

  2. Application.ScreenUpdating = 0
  3. Dim rng As Range, d As Object, ws As Worksheet
  4. Set ws = ActiveSheet
  5. ws.AutoFilterMode = False
  6. c = [a5].CurrentRegion.Columns.Count
  7. Set d = CreateObject("scripting.dictionary")
  8. Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))
  9. a = rng.Columns(3)
  10. For i = 2 To UBound(a)
  11.     d(a(i, 1)) = ""
  12. Next
  13. k = d.keys
  14. For i = 0 To UBound(k)
  15.     ws.Copy after:=Sheets(Sheets.Count)
  16.     ActiveSheet.AutoFilterMode = False
  17.     [a5].CurrentRegion.Clear
  18.     With ws
  19.         rng.AutoFilter Field:=1, Criteria1:=k(i)
  20.         .[a5].CurrentRegion.Copy [a5]
  21.         
  22.     End With
  23.         
  24.     ActiveSheet.Name = [A6].Value
  25. Next
  26. Application.ScreenUpdating = 1

  27. With Sheets("data").Activate
  28.     If ActiveSheet.FilterMode Then
  29.       ActiveSheet.ShowAllData
  30.     End If
  31.    
  32. End With

  33. End Sub
複製代碼

作者: catbears    時間: 2024-12-10 15:45

嘗試著逐行分解
發現第9行當中
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))

Rows.Count > 這邊的資料會跳到整張EXCEL表中的最後一行,有點看不太懂您要做的事情,因此僅能告知您的這部分開始就已經跳脫出程式操作的內容了
是否能稍作說明您每步驟想做的事情呢?
作者: 准提部林    時間: 2024-12-11 12:28

本帖最後由 准提部林 於 2024-12-11 19:48 編輯

1.找最後非空行, 應使用 xlup(3), 而非 (1)
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(1).Row, c))
Set rng = Range([a5], Cells(Cells(Rows.Count, 1).End(3).Row, c))

2.篩選欄位
a = rng.Columns(3) '篩選文字在第3欄
rng.AutoFilter Field:=1, Criteria1:=k(i) '這個1應改成3

3.工作表名稱
ActiveSheet.Name = [C6].Value




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)