返回列表 上一主題 發帖

[發問] Sheet中的值,依A欄中的部門複製至新的Sheet

JH8888

帖子
4 
主題
1 
精華
0 
積分
9 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2012-2-14 
最後登錄
2022-4-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-2-14 15:54 | 只看該作者

[發問] Sheet中的值,依A欄中的部門複製至新的Sheet

請問各位,有那位可以幫幫忙.

問題:我有一個sheet中要依部門資料,自動拆分成多個sheet或多個xls
     其中資料是以部門排序,相同的部門需產生sheet或一個xls(檔名依部門名稱命名)

以上還煩請各位高手幫忙解惑!
謝謝!

資料處理.rar (7.25 KB)

Excel

收藏 分享
JH8888

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-2-14 18:09 | 只看該作者
回復 1# JH8888
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, S As String, xi As Integer
  4.     Application.DisplayAlerts = False                                          ' Microsoft Excel 顯示特定的警告和訊息則為 True。讀/寫 Boolean
  5.     Application.ScreenUpdating = False                                         '如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean。
  6.     With Sheets("Sheet1")
  7.         For xi = Sheets.Count To 1 Step -1
  8.             If Sheets(xi).Name <> .Name Then Sheets(xi).Delete                  '刪除 原有檔案 須由後往前刪
  9.         Next
  10.         If .AutoFilterMode Then .AutoFilterMode = False                         '取消篩選
  11.         .Range("a1").AutoFilter                                                 '[自動篩選] 篩選出一個清單
  12.         Set Rng = .AutoFilter.Range.Columns(1).Cells                            '[自動篩選]的第1欄
  13.         For xi = 2 To Rng.Count                                                  '處裡:  第1欄
  14.             If InStr(S, "," & Rng(xi) & ",") = False Then                        '檢查  是否已出現過
  15.             .Range("a1").AutoFilter Field:=1, Criteria1:=Rng(xi)                 '沒出現: 指定為篩選值
  16.             S = S & "," & Rng(xi) & ","                                          '加入已出現過的字串中
  17.             Sheets.Add , Sheets(Sheets.Count)                                   '新增一工作表
  18.             ActiveSheet.Name = Rng(xi)                                           '命名:篩選值
  19.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy ActiveSheet.[a1]    '複製: 資料表中篩選出的資料 ->新工作表的[A1]
  20.             ActiveSheet.Cells.Columns.AutoFit                                   'AutoFit: 將範圍中的欄寬和列高調整為最適當的值。
  21.             End If
  22.         Next
  23.         .AutoFilterMode = False                                                  '取消篩選
  24.         .Activate                                                                '回到 資料表
  25.     End With
  26.     Application.ScreenUpdating = True
  27.     Application.DisplayAlerts = True
  28. End Sub
複製代碼

TOP

JH8888

帖子
4 
主題
1 
精華
0 
積分
9 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2012-2-14 
最後登錄
2022-4-8 
3#
發表於 2012-2-15 04:45 | 只看該作者
本帖最後由 JH8888 於 2012-2-15 10:05 編輯

多謝版主解救,學習了,把巨集加入了,並加上可以轉存成個別xls
感謝!

好久沒來這裡了啊,連帳號都要重來了啊!
這裡仍是VBA交流的首選.:)

資料處理.rar (22.54 KB)

更新

JH8888

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2012-2-15 08:08 | 只看該作者
回復 3# JH8888
看到你附檔的 Sub Copy_Every_Sheet_To_New_Workbook()
我很好奇,你可以自己寫為何還要發問!

TOP

JH8888

帖子
4 
主題
1 
精華
0 
積分
9 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2012-2-14 
最後登錄
2022-4-8 
5#
發表於 2012-2-15 10:18 | 只看該作者
我本身對VBA算是初級班,程式碼大約看的懂,
有一陣子沒碰VBA了,只是剛好有這個功能的需求,google蒐了一下沒什麼類似的,
如果有找到類似的我改改還可以,但要新建就有點困難,
剛好又蒐到這個網站,才發現我曾經在這註冊過,但舊帳號似乎錯過轉換期了啊!
VBA的指令部份仍不太熟悉,還很多要學習的地方,
另外那個功能也是在google蒐到的,並把他加入分享給其他如有需要的人可以一起用.
感謝你熱心的回復.
JH8888

TOP

felixchi

帖子
2 
主題
0 
精華
0 
積分
2 
點名
0  
作業系統
WINDOWXP 
軟體版本
OFFICE2003 
閱讀權限
10 
註冊時間
2011-10-18 
最後登錄
2012-2-15 
6#
發表於 2012-2-15 11:52 | 只看該作者
a very good practice for beginner like me. Thx

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
7#
發表於 2012-2-15 14:58 | 只看該作者
以前我也有問過相類似的問題~ 也是G大大幫忙協助解惑~
自己也依此自行修改~ 完成該工作~
提供給您參考~
http://forum.twbts.com/viewthread.php?tid=2855&highlight=
學習才能提升自己

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
返回列表 上一主題