[發問] 將資料自動分類功能

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

2^#

發表於 2014-1-29 23:35 | 顯示全部帖子

我想所需功能大概分兩部分
一是在工作表2由上而下找到空白可用處，再把工作表1的資料複製過來
二是去判斷類別，再將資料複製到各工作表

首先由上而下找到空白我寫不太出來
一直說有錯
Private Sub CommandButton1_Click()
Dim i As Integer
i = 1

Do
   If Worksheets("工作表2").Range(Cells(i, 1), Cells(i, 7)) = "" Then
   MsgBox (i)                '顯示第i行是完全空白，表示可用
   Exit Do
   End If
i = i + 1
Loop

End Sub

我想做到逐列尋找(用i來做)
然後一個範圍內都是空白，語法不會寫，range()從第i列的第1欄到第7欄都空白就表示已經到底
若其中一欄非空白，就i=i+1繼續找下去

可是遇到瓶頸了
希望有大大能解答
謝謝

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

3^#

發表於 2014-1-31 11:10 | 顯示全部帖子

回復 3# GBKEE

感謝GBKEE大大的回覆，功能正常，除了一些小問題

1：Option Explicit 程式跟我說有問題，加上'當成註解後，運作正常

2：我的需求有點小出入
   (1)我其他的工作表(3~5)因為有畫好表格(單子)，所以不能刪除
         只能把工作表1的資料複製、貼進去
      (每張表格只能填10筆資料，所以超過10筆才要另開新表，原因在此)

         我想是不是把下列程式刪除?
         For Each Sh In Sheets
         If Sh.Name <> "工作表1" And Sh.Name <> "工作表2" Then Sh.Delete
         '活頁簿只留工作表1：是輸入區,工作表2：是歷史記錄
         Next

         改成，把工作表3~5裡面的舊資料清空，例如A5~E14=""

      (2)在挑選類別的時候，例如有好幾筆
         第1筆，如果是員工類，就放到"員工"工作表，A5~E5  (單子第1筆)
         第2筆，如果是員工類，就放到"員工"工作表，A6~E6 (單子第2筆)
         第3筆，如果是員工類，就放到"員工"工作表，A7~E7  (單子第3筆)
         第4筆，如果是公司類，就放到"公司"工作表，A5~E5  (單子第1筆)
         第5筆，如果是廠商類，就放到"廠商"工作表，A5~E5  (單子第1筆)
         第6筆，如果是公司類，就放到"公司"工作表，A6~E6  (單子第2筆)
         第7筆，如果是公司類，就放到"公司"工作表，A7~E7  (單子第3筆)
         以此類推，

         至於超過10筆就開新工作表部分，功能均正常，我再稍微修改即可

以上，感謝

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

4^#

發表於 2014-1-31 14:00 | 顯示全部帖子

Private Sub CommandButton1_Click()
'Option Explicit (刪除)
'Sub Ex() (刪除)
Dim i As Integer, Sh As Worksheet
Application.DisplayAlerts = False
For Each Sh In Sheets
If Sh.Name <> "工作表1" And Sh.Name <> "工作表2" Then 'Sh.Delete (把刪掉工作表的動作取消)
'活頁簿只留工作表1：是輸入區,工作表2：是歷史記錄
Sh.Range("A2:E11").Value = "" '(自己加上清除其餘工作表中，特定範圍清空資料的功能)
End If
Next
With Sheets("工作表2")
If .UsedRange.Rows.Count = 1 Then '沒有歷史紀錄
Sheets("工作表1").UsedRange.Copy '複製(含標頭)
.Range("a1").PasteSpecial xlPasteValues
Else
Sheets("工作表1").UsedRange.Offset(1).Copy '複製(不含標頭)
.Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
'Offset(3) :空2列->第3列貼上
End If
.UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
'進階篩選 E欄不重複資料到工作表最右欄 ***取得類別的分類***
i = 2
.Cells(1, .Columns.Count - 1) = .UsedRange.Range("E1") '進階篩選的欄位名稱是E欄的標頭
Do While .Cells(i, .Columns.Count) <> "" '工作表最右欄的儲存格 <>""
'Set Sh = Sheets.Add(, Sheets(Sheets.Count)) '新增的類別工作表 (這邊不新增工作表，故刪除)
'Sh.Name = .Cells(i, .Columns.Count) ' (這邊不新增工作表，故刪除)
'.Cells(2, .Columns.Count - 1) = Sh.Name ' (這邊不新增工作表，故刪除)
'這邊應該要加入，判斷為哪一類別，並把該列資料複製到那個類別的工作表去，但我不會寫，是下面這行?
.UsedRange.AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count - 1).Resize(2), Sh.[a1], True '左邊這行除錯說沒有WITH，但明明就有，好怪
'工作表2 進階篩選準則[分類]="工作表1"最右欄的儲存格, 複製到新增的類別工作表[A1]
Do While Sh.UsedRange.Rows.Count > 11 '資料列>11列
Sh.Copy , Sheets(Sh.Index) '1 原工作表複製
Sh.Rows("11:" & Sh.Rows.Count).Delete '2 原工作表刪除11列以下的資料(保持10列)
Set Sh = ActiveSheet '3 複製的工作表指定給變數
Sh.Rows("2:11").Delete '4 複製的工作表刪除2:11列的資料
Loop
i = i + 1
Loop
.Cells(1, .Columns.Count).CurrentRegion = ""
End With
'End Sub (原本的，刪除)
End Sub

複製代碼

回復 4# iceandy6150

我修改了一下大大的程式
可是卡住不能運作了

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

5^#

發表於 2014-1-31 18:20 | 顯示全部帖子

回復 5# iceandy6150

已附加檔案
   工作表1如果按鈕不小心按到兩次
   會複製兩次到工作表2
   其餘工作表的表格我簡化過，跟正本差一些而已
   謝謝

Book1.rar (24.45 KB)

測試檔

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

6^#

發表於 2014-1-31 18:57 | 顯示全部帖子

補充一下，實際上類別不止三種，可能高達十多種，我範例是舉三例
另外每一類別的工作表我可以手動建立
萬一後面又要再多新的類別，我也可以慢慢增加

要搜尋類別，我是想到兩種方式
1.是用CASE，把會用到的都先內建，再把各類編號
IF 工作表1.類別.cells().value = "公司" then k=1
IF 工作表1.類別.cells().value = "員工" then k=2
以此類推
然後CASE(K)做判斷  去做複製、貼過去的動作

2.設一變數A = 工作表1的第i筆資料的類別的值  (例如是公司)
再逐一找工作表的名稱，看是否與A一樣，若一樣則去做複製、貼過去的動作
For Each Sh In Sheets
      If Sh.Name = A then  做複製、貼過去的動作
      end if
next

不曉得這樣行不行得通?
謝謝

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

7^#

發表於 2014-2-2 23:54 | 顯示全部帖子

回復 8# GBKEE

GBKEE版大您好

試了一下您的檔案後，問題如下

一、 With Sheets("工作表2")
      If .UsedRange.Rows.Count = 1 Then             '沒有歷史紀錄
      這一行無論有沒有資料都無法執行，就直接跳ELSE那一塊了
      所以我改成
      If .Cells(1, 1).Value = "" Then    功能相同

二、篩選及建立類別工作等工作，所用到的資料應該是輸入區(工作表1)的資料
   所以我多加了end with
   再多加 With Sheets("工作表1")，讓篩選及建立類別工作等工作正常運作

三、 Else
         Sheets("工作表1").UsedRange.Offset(1).Copy  '複製(不含標頭)
         .Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
         'Offset(3) :空2列->第3列貼上

         這邊的 .Range("A" & .UsedRange.Rows.Count)老是會算錯
         嚴格來說是.UsedRange.Rows.Count會出錯
         我特地加兩行程式，顯示一下到底算出幾列來
         k = Sheets("工作表2").UsedRange.Rows.Count
         MsgBox (k)
         結果工作表2只有7列，程式跑出：已使用26列

         我不死心，於是在工作表2弄了一個按鈕
         一樣的程式跑看看已使用的列數，秀出來
         還是一樣已使用26，明明都是空白，我不知道為什麼
         但是拿來算工作表1就很正確

我上傳我修改後的檔案
目前狀態是，工作表1已經輸入一次資料，按了一次按鈕
所以產生了該產生的其他類別工作表
也把工作表1該複製的資料，都貼到工作表2了

工作表1裡面，是輸入好第2次的資料，但還沒按按鈕
(因為貼的動作會錯<.UsedRange.Rows.Count會出錯>)

再麻煩幫我看看問題出在哪裡
謝謝

ttt.rar (18.02 KB)

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

8^#

發表於 2014-2-3 09:24 | 顯示全部帖子

回復 10# GBKEE

感謝GBKEE版大提醒，也很奇怪為什麼工作表2最右邊會有東西
再回頭去看工作表1最右邊也有東西，難怪一直出錯
都刪掉後，所有功能正常運作
感謝再感謝

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

9^#

發表於 2014-2-3 10:23 | 顯示全部帖子

回復 12# GBKEE

原來那一行的意思是這樣呀
多謝G大講解

但是原本G大的程式，會將工作表2裡面的所有歷史資料去做動作 (新增類別工作表...等)
而我原本要做的是，工作表1是輸入區，針對輸入區的資料去做動作
工作表2純粹是存資料用的
工作表1可能每天要用個1~3次，工作表2只是紀錄每天的項目

第1次我可能輸入10筆，按下按鈕，產生兩類的工作表，列印當收據後就OK
第2次我可能輸入35筆，按下按鈕，產生五類的工作表，每一類列印後就OK
第3次我可能輸入3筆，按下按鈕，產生一類的工作表，這一類列印後就OK
而工作表2則是記錄這48筆資料，方式是10筆後空兩行，再35筆後空兩行，再3筆

那請問G大， .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
這一行還是要放在工作表2囉? 讓篩選出來的分類會放到工作表2的IV欄
但是這樣，下面要產生新的類別工作表的程式，我放在工作表1，又會找不到篩選出來的分類
怎麼改比較好呢?

應該是這行要改，但我不會改成指定去找工作表2的IV欄
For Each Ar In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '篩選出的資料列

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

10^#

發表於 2014-2-3 11:06 | 顯示全部帖子

回復 13# iceandy6150

G大，我發現一點了
進階篩選放在Sheets("工作表1")是可以的
當我在工作表1輸入好資料後，按下按鈕

透過下面這一行
.UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
可以篩選出有多少類別，並顯示在"工作表1的最右欄"

然後
就會去做產生新的工作表(改名字，變成類別名)
然後把該類的資料逐一放入

都好了以後，應該要清除<工作表1的最右欄>
那我也發現G大寫得程式中有下面這一行
.Cells(1, .Columns.Count).CurrentRegion = ""
但是這一行只把最近用到的類別給清掉

例如依序產生了公司-->廠商-->內部-->員工這四類
就只會清掉員工
等程式跑完，會在<工作表1的最右欄>殘存公司、廠商、內部
如果那一行的指令可以完全清除<工作表1的最右欄>的所有東西
那一切就沒問題了!

再請G大幫忙解答，謝謝

哈囉~大家好呀