iceandy6150

回復 10# GBKEE


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

GBKEE

回復 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個儲存格->進階篩選的資料顯示的地方

複製代碼

iceandy6150

回復 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  '篩選出的資料列

iceandy6150

回復 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大幫忙解答，謝謝

iceandy6150

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

複製代碼

回復 14# iceandy6150

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

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

iceandy6150

回復 15# iceandy6150

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

下載 (135.24 KB)
列印單

2014-2-3 16:42

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

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

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

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

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

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

下載 (74.95 KB)
總表

2014-2-3 16:50

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

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

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

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

還是有別的好方法?

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

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

iceandy6150

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

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

GBKEE

回復 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# 檔案的私密資料遮蔽,上傳看看

iceandy6150

回復 18# GBKEE

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

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

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

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

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

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

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

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

下載次數: 13

2014-2-4 11:02

GBKEE

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