返回列表 上一主題 發帖

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

回復 10# GBKEE


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

TOP

回復 11# iceandy6150
須多了解程式碼的意義
我的是Sheets("工作表2") 你改為 Sheets("工作表1")
  1. With Sheets("工作表1")'
  2.     .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
  3.     'AdvancedFilter:進階篩選
  4.    'xlFilterCopy:進階篩選的資料顯示在其他地方
  5.    '.Cells(1, .Columns.Count) ->工作表的最右欄第1個儲存格->進階篩選的資料顯示的地方
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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  '篩選出的資料列
哈囉~大家好呀

TOP

回復 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大幫忙解答,謝謝
哈囉~大家好呀

TOP

  1. Option Explicit   '必須置於模組頂端 強制宣告變數
  2. Private Sub CommandButton1_Click()
  3.     Dim Sh As Worksheet, i As Integer, ii As Integer, r As Integer, Ar 'Dim 宣告變數
  4.     Dim k As Integer
  5.    
  6.     Application.DisplayAlerts = False
  7.     Application.ScreenUpdating = False
  8.     For Each Sh In Sheets
  9.         If Sh.Name <> "工作表1" And Sh.Name <> "工作表2" And Sh.Name <> "表格範本" Then Sh.Delete
  10.         '活頁簿只留 工作表1:是輸入區,工作表2:是歷史記錄 ,"表格範本"
  11.     Next
  12.    
  13.     With Sheets("工作表2")
  14.         If .UsedRange.Rows.Count = 1 Then              '沒有歷史紀錄
  15.            '.UsedRange.Rows.Count = 1

  16.              Sheets("工作表1").UsedRange.Copy            '複製(含標頭)
  17.             .Range("A1").PasteSpecial xlPasteValues
  18.             
  19.         Else
  20.             Sheets("工作表1").UsedRange.Offset(1).Copy  '複製(不含標頭)
  21.             Sheets("工作表2").Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
  22.             'Offset(3) :空2列->第3列貼上
  23.            
  24.         End If
  25.         

  26.         
  27.     End With
  28.    
  29.    
  30.     With Sheets("工作表1")
  31.    
  32.     .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
  33.     '進階篩選 E欄 不重複資料到工作表最右欄 ***取得類別的分類***
  34.     'AdvancedFilter:進階篩選
  35.     'xlFilterCopy:進階篩選的資料顯示在其他地方
  36.     '.Cells(1, .Columns.Count) ->工作表的最右欄第1個儲存格->進階篩選的資料顯示的地方
  37.         
  38.         i = 2
  39.         Do While .Cells(i, .Columns.Count) <> ""                  '工作表最右欄的儲存格 <>""
  40.             .Range("A:E").AutoFilter 5, .Cells(i, .Columns.Count)          'AutoFilter: 自動篩選 ,第5欄(類別)的準則為 .Cells(i, .Columns.Count)
  41.             Sheets("表格範本").Copy , Sheets(Sheets.Count)
  42.             Set Sh = ActiveSheet
  43.             Sh.[a1] = .Cells(i, .Columns.Count) & "支出表"
  44.             Sh.Name = .Cells(i, .Columns.Count)
  45.             r = 5
  46.             For Each Ar In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows  '篩選出的資料列
  47.                 If r = 17 Then
  48.                     r = 6
  49.                     Sh.Copy , Sheets(Sheets.Count)
  50.                     Set Sh = ActiveSheet
  51.                     Sh.Range("A6:E16") = ""
  52.                 End If
  53.                 Sh.Cells(r, "a").Resize(, Ar.Columns.Count) = Ar.Value   'Index(AR, ii) :讀取陣列
  54.                 r = r + 1
  55.            Next
  56.            i = i + 1
  57.         Loop
  58.         
  59.         k = 1
  60.         Do While .Cells(k, .Columns.Count) <> ""
  61.         .Cells(k, .Columns.Count) = ""
  62.         k = k + 1
  63.         Loop
  64.         
  65.         '.Cells(1, .Columns.Count).CurrentRegion = ""
  66.         .AutoFilterMode = False
  67.     End With
  68.     Application.ScreenUpdating = True
  69.     Me.Activate
  70. End Sub
複製代碼
回復 14# iceandy6150

我試出來了,貼上代碼及附檔
感謝G大熱心教學

只要在工作表1,輸入資料,按下按鈕,就能自動產生相對應的工作表
並將資料分類好放到相對應的工作表內,可供使用者直接列印出來
而每次動作也會記錄在工作表2中,當作歷史紀錄

ttt.rar (19.09 KB)

完成檔

哈囉~大家好呀

TOP

回復 15# iceandy6150

G版大,不好意思又來發問了,發現與實際應用有點落差


首先是圖中紅色部分
1.第一個紅框裡的東西和工作表表名是一樣的
而且要怎麼設定一個內放兩行,我不會

2.問題比較大的是右邊的紅框
因為每一類工作表它的字號不一樣
可能是庶字008號、013號,而且沒啥規則可言
在產生新的工作表時,還要兼顧裡面字號是否正確
   
3.三個藍框是要從輸入區複製資料過來貼上
    並不是整列的資料都貼

4.綠框是合計,可以的話直接程式寫好,產生新工作表就已有
   或是再自己手動設定也行

5.右下兩個黃框,sheet1就是輸入區,也就是範例的工作表1
   總表,也就是歷史資料區,範例的工作表2

6.圖片正下方可以看到,種類超多的,並有各自的代號

接下來看一下總表的部分,(也就是歷史資料),我貼一部分上來



1.總共有7個欄位:序號、日期、物品、對象、金額、敘述、類別

2.圖中紅框1.2.3放到各類別工作表中,順序卻不一樣,變2.3.1中間還有空格

目前打算是這樣
SHEET1就是輸入區,長得就跟<總表>一樣的順序
所以要複製貼上會比較方便

但如果要用G大您寫好的程式去改
可能還要用一個工作表,裡面放參考值,比如說
類別為[一般事務費],那sh.name就是[一般事務費279],字號為[庶字第016號]
以此類推
把每一類別都打好,讓程式參照,以便新產生工作表時可以正確套用

還是有別的好方法?

另外一條路,就是在sheet1(輸入區),逐一列判斷為哪一類
再做複製、貼上到該類工作表去的動作
(如同原本舊方法,建立好各類工作表,有資料才貼進來
沒資料就空著不動)
這樣是不用顧慮到各類工作表的字號不同問題

該怎麼辦呢?
請再幫我想想,謝謝
哈囉~大家好呀

TOP

回復 16# iceandy6150

請問版上各位大大
一張工作表中,我只想針對某個範圍下程式,有語法嗎?

例如,我想判斷工作表1中的D7:J19這個範圍,已經被使用過的列有幾列
(不要判斷整張工作表)
該怎麼寫語法?

Private Sub CommandButton1_Click()
    Dim myRgn As Range
    Dim a As Integer
    Set myRgn = Range("D7:J19")
    ThisWorkbook.Names.Add "DataRange", myRgn
'(以上是網路看來的)   

    With Sheets("工作表1")
        
         With Range("DataRange")
         a = .UsedRange.Rows.Count
         End With
         
    End With
   
    MsgBox (a)
      
End Sub

可是都跟我說程式不對
求救一下,謝謝
哈囉~大家好呀

TOP

本帖最後由 GBKEE 於 2014-2-4 09:35 編輯

回復 17# iceandy6150
  1. With Sheets("工作表1")  '工作表物件才有UsedRange物件   
  2.          With .Range("DataRange")  ' 沒有UsedRange
  3.          'a = .UsedRange.Rows.Count '
  4.           MsgBox Application.CountA(.Columns(1)) '指定"DataRange"第一欄->使用的列數
  5.        ' Application.CountA : VBA中使用工作表函數 CountA  
  6.        MsgBox Application.CountA(.Cells)      '"DataRange"範圍內
  7.          End With         
  8.     End With
複製代碼
15#
  1. 'k = 1
  2.         'Do While .Cells(k, .Columns.Count) <> ""
  3.         '.Cells(k, .Columns.Count) = ""
  4.         'k = k + 1
  5.         'Loop
  6.         .Cells(k, .Columns.Count).EntireColumn = ""    'EntireColumn :整欄
  7.         '.Cells(1, .Columns.Count).CurrentRegion = ""  'CurrentRegion:連續的資料範圍
複製代碼
16# 檔案的私密資料遮蔽,上傳看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 18# GBKEE

G版大您好
我將實際要用的檔案上傳,部分資料已蓋掉

原本使用者是將要輸入的資料直接打進<總表>
再將各類別的工作表所需要的儲存格設定 =總表的D7  (舉例)
但是每次總表一改,資料一增加,就又要去該類工作表設定  =總表的D28  (舉例)
於是我想寫程式改善,不用每次都去改

如果程式能自動判斷該筆資料是屬於哪一類,就自動貼過去那一類的工作表
就簡單多了
可是如果程式判斷的是<總表>,很難分辨哪些是舊的,哪些是這次要用的
於是繞一條路,用一個輸入區<sheet1> (也就是發問範例的<工作表1>)
讓程式判斷<輸入區>的資料,並做分類及貼過去的動作
再將本次資料複製貼到<總表>去

G大您的作法是,利用產生新表的方式

我原本是想說,程式跑的時候
1.先從<輸入區>複製、貼過去<總表>,空兩列(為了支票號碼要用)(這手動設定)
   逐工作表內的區域清空舊資料 (保留表格及格式,要放資料的地方清空就好)

2.逐列判斷<輸入區>,若A類,sheetA選擇,判斷特定範圍是否還有空格,放入資料,
   (所以我才要問怎麼判斷工作表中,特定範圍已使用的列數,才能知道是否還有空格)
   若滿了,複製sheetA,清空,改名sheetA(2),放入剩餘資料(這部分發問的範例已解答)

我想兩種方法應該都可以做到相同結果
只是我比較不熟
所以請G大及版上高手們看看
幫小弟想一下解決方法
謝謝

零用金清單-上傳用.rar (121.11 KB)
哈囉~大家好呀

TOP

本帖最後由 GBKEE 於 2014-2-4 14:43 編輯

回復 19# iceandy6150
附檔上總表G欄類別沒數字, 但工作表[保險231],[通訊203]..有數字 這些工作表的命名規則你沒說明!
[總表]資料可在H欄加註辨別新舊資料
16# 可能還要用一個工作表,裡面放參考值,比如說 類別為[一般事務費],那sh.name就是[一般事務費279],字號為[庶字第016號]
庶字第016號 在何處??
請告知疑惑,程式才寫的下去.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大,小人氣大。
返回列表 上一主題