將資料自動分類功能 - Excel程式區

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

12^#

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

回復 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(輸入區)，逐一列判斷為哪一類
再做複製、貼上到該類工作表去的動作
(如同原本舊方法，建立好各類工作表，有資料才貼進來
沒資料就空著不動)
這樣是不用顧慮到各類工作表的字號不同問題

該怎麼辦呢?
請再幫我想想，謝謝

哈囉~大家好呀

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

13^#

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

回復 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

可是都跟我說程式不對
求救一下，謝謝

哈囉~大家好呀

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

14^#

發表於 2014-2-4 11:02 | 顯示全部帖子

回復 18# GBKEE

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

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

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

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

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

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

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

零用金清單-上傳用.rar (121.11 KB)

哈囉~大家好呀

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

15^#

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

回復 20# GBKEE

A-附檔上總表G欄類別沒數字, 但工作表[保險231],[通訊203]..有數字這些工作表的命名規則你沒說明!
   [總表]資料可在H欄加註辨別新舊資料
   16# 可能還要用一個工作表，裡面放參考值，比如說類別為[一般事務費]，那sh.name就是[一般事務費279]，字號為[庶字第016號]
B-庶字第016號在何處??

G大，關於問題A，因為原本是人工處理，<總表>中的G欄只會看到類別，不會有數字
比方說<總表>裡面[類別]打的是[保險]，人眼一看就知道要去找工作表<保險231>
然後把<保險231>裡面第一列D7，設定成 =總表!D48  (設定成在總表中的位置)
這樣就可以把<總表>的資料對應到<保險231>中
萬一有第2.3.4...筆資料，還得人工逐一設定成 =總表!D??

所以，可能也沒什麼命名規則，因為我也不知道為什麼保險要用231，通訊要用203，真的很抱歉
我只是好心幫忙，想說把人工處理的部分，利用程式做完而已

關於問題B，就在每個工作表的I3裡面，("零用金清單"這幾個字的右下方)
與問題A同，好像也沒規則可言，我每個類別點來點去，發現是不一樣的字號
往前幾個回文，我有貼圖片，裡面也可看到

感恩，謝謝

哈囉~大家好呀

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

16^#

發表於 2014-2-5 17:34 | 顯示全部帖子

感謝G大及Y大的回復

我想再問一兩個小問題

1.每次寫程式，我都知道我想要做到什麼功能，但是程式都寫不出來，或錯
要買什麼書來看才能增進我的程式能力呢?
錄製巨集只能錄到操作過程，但是人為判斷及選擇，巨集錄不到

2.我現在設了一個參照表
A B
1 物品物品271
2 保險保險236
3 一般一般218

也將G大教的部分功能修改，我想讓程式從SHEET1(輸入區)去找類別
然後會去<參照表>尋找，例如找到(保險)(A,2)，那就將(B,2)的值傳給K
但是不知道如何做到，再麻煩各位熱心版友
謝謝

Private Sub CommandButton4_Click()
Dim i As Integer, j, k As String
With Sheets("Sheet1")
.UsedRange.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
End With
i = 2
With Sheets("參照表")
Set Rng = .Range("A:A").Find(what:=Sheets("Sheet1").Cells(i, .Columns.Count))
k =.Range("A:A").Find(what:=Sheets("Sheet1").Cells(i, .Columns.Count).Next.Value)
'我要將所找到的儲存格右邊那格的值傳給K，可是語法不對，我也不會
MsgBox (Rng)
MsgBox (k)
End With
End Sub

複製代碼

哈囉~大家好呀

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

17^#

發表於 2014-2-5 20:46 | 顯示全部帖子

回復 26# GBKEE

天啊，就這麼一行
k = Rng.Offset(, 1)
G大，很感謝你
我下午試了一個多小時，就試不出來
activecell.next.value不行
selection.next.value不行
先selection.select再activecell.next.value也不行
selection.address可以秀出Rng找到哪一個
但是傳回來的是$A$5的東西
我想要右移一格$B$5的值卻不會寫
有address要去找該位置的值，我也不會
我都快瘋了我

G大，像我這種問題，靠錄製巨集能有解答？
我買了一本VBA的書，有300項以上的語法，還是查不到
唉…超菜的我

哈囉~大家好呀

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

18^#

發表於 2014-2-6 00:39 | 顯示全部帖子

Private Sub CommandButton3_Click()
Dim Sh As Worksheet, i As Integer, ii As Integer, R As Integer, Ar 'Dim 宣告變數
Dim k As Integer
Dim j As String
Dim A As Range, Rng As Range, xRow As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each Sh In Sheets
If Sh.Name <> "Sheet1" And Sh.Name <> "總表" And Sh.Name <> "表格範本" And Sh.Name <> "黏存單(零)" And Sh.Name <> "參照表" Then Sh.Delete
'活頁簿只留工作表1：是輸入區,工作表2：是歷史記錄 ,"表格範本"，黏存單(零),參照表
Next
With Sheets("總表")
If .UsedRange.Rows.Count = 1 Then '沒有歷史紀錄
Sheets("Sheet1").UsedRange.Copy '複製(含標頭)
.Range("A1").PasteSpecial xlPasteValues
Else
Sheets("Sheet1").UsedRange.Offset(1).Copy '複製(不含標頭)
Sheets("總表").Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
'Offset(3) :空2列->第3列貼上
End If
End With
With Sheets("Sheet1")
.UsedRange.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
'進階篩選 E欄不重複資料到工作表最右欄 ***取得類別的分類***
'AdvancedFilter:進階篩選
'xlFilterCopy:進階篩選的資料顯示在其他地方
'.Cells(1, .Columns.Count) ->工作表的最右欄第1個儲存格->進階篩選的資料顯示的地方
i = 2
Do While .Cells(i, .Columns.Count) <> "" '工作表最右欄的儲存格 <>""
.Range("A:G").AutoFilter 7, .Cells(i, .Columns.Count) 'AutoFilter: 自動篩選 ,第7欄(類別)的準則為 .Cells(i, .Columns.Count)
Sheets("表格範本").Copy , Sheets(Sheets.Count)
Set Sh = ActiveSheet
With Sheets("參照表")
Set Rng = .Range("A:A").Find(what:=Sheets("Sheet1").Cells(i, .Columns.Count))
'MsgBox (Rng)
j = Rng.Offset(, 1)
End With
'@@@上面那行 j = Rng.Offset(, 1) 有時候跑一次能執行，後來就警告了
Sh.[C2] = j '@@@有時候是警告這一行錯誤
Sh.Name = Rng
j = "" '這兩行是我覺得使用後清空，加這兩行錯誤也沒消失
Rng = ""
For Each xRow In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '自動篩選範圍列的集合
If xRow.Row > 1 Then
R = Application.CountA(Sh.[D7:D19]) '有輸入的資料數
With Sh.[D7].Offset(R)
.Cells(, 1) = xRow.Range("D1")
.Cells(, 5) = xRow.Range("F1")
.Cells(, 7) = xRow.Range("E1")
'@@@ 大大，這邊可能還要再把日期加進E3，我不會寫 (其實看不太懂為什麼，所以不會改)
End With
If Application.CountA(Sh.[D7:D19]) = 13 Then
Sh.Copy , Sh
Set Sh = ActiveSheet
Sh.[D7:J19] = ""
End If
End If
Next
i = i + 1
Loop
k = 1
Do While .Cells(k, .Columns.Count) <> ""
.Cells(k, .Columns.Count) = ""
k = k + 1
Loop
'.Cells(1, .Columns.Count).CurrentRegion = ""
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
Me.Activate
End Sub

複製代碼

回復 26# GBKEE

大大，我把您第一次的程式修改一下，可是有些地方警告說沒有WITH和區域變數
快完成了，幫我看看，謝謝

[attach]17426[/attach]

[attach]17427[/attach]

庶字第XX號，的XX由人工手動輸入即可

[attach]17428[/attach]

哈囉~大家好呀

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

19^#

發表於 2014-2-6 01:10 | 顯示全部帖子

版大，不好意思，不知道為什麼會重覆傳，還有檔案、圖片都上不去，有空再傳一次，重覆的文再請版大刪掉，謝謝

哈囉~大家好呀

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

20^#

發表於 2014-2-6 07:14 | 顯示全部帖子

回復 34# c_c_lai

C大您好，不知道為什麼，第3頁以後的文章，包括您的文章，都無法顯示了
我只能從[提醒]裡面去按回覆您的文章

昨晚我用IE開兩三個視窗無效，用CHROME開兩三個也無效
自己回覆的帖也看不到，只能看到第30則文章而已

[attach]17434[/attach]

哈囉~大家好呀