123456
返回列表 上一主題 發帖

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

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
51# 跳轉到 »
發表於 2014-2-13 23:24 | 只看該作者
回復 50# GBKEE

感謝G大，太神了

這麼詭異的表格也能找到方法統計
還不是很懂程式原理
但是自己測試是能正常運作
明天找使用者問看看

再次感謝!
哈囉~大家好呀

TOP

tainanfriend

帖子
6 
主題
3 
精華
0 
積分
9 
點名
0  
作業系統
windows 8 
軟體版本
2013 
閱讀權限
10 
註冊時間
2014-2-1 
最後登錄
2014-2-16 
52#
發表於 2014-2-14 12:41 | 只看該作者
真的太厲害了
我是有看過另外一種資料分類的程式
它是用Excel中篩選的功能
將資料篩選出來後
再分類

不過
這裡的比較厲害

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
53#
發表於 2014-2-15 18:51 | 只看該作者
本帖最後由 iceandy6150 於 2014-2-15 18:56 編輯

回復 50# GBKEE


G大，不好意思，又來發問了

壹、請問您的程式中，
        Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("F1")                  'Range("F1"):金額位置
       是去抓取下圖中ABCD哪一個位置呢?

      

       雖然四個位置的值都一樣，實際使用上要選C
       不過只有A，是有月日可以對照
       好奇問一下

貳、其他的部分也需要加進程式中，可是我不會改
        
      
        右上方黃色的格子，是要填入 <銷貨收入47-48>的F欄的倒數第2個值，也就是圖1的C
        但我上次弄錯了，以為是最後一個格子
        所以原本程式如下：
        Dim j
        With Sheets("銷貨收入47-48").Range("F:F")

       'Sheets("損益表").Range("C6").Value = .Cells(.Count).End(xlUp).Value 這行無法直接動作，故放棄

       j = .Cells(.Count).End(xlUp).Value
       Sheets("損益表").Range("C6").Value = j
    End With

     那我改成
        j = .Cells(.Count - 1).End(xlUp).Value  失敗，還是抓最下一格
         j = .Cells(.Count).End(xlUp).Offset(-1).Value 失敗，J值是空的

     [問題一]該怎麼改成倒數第二格呢?
   
[問題二]如果要使用G大的程式去動作，怎麼加呢?
另外，有些範圍也想加

圖2的藍色部分
期初存貨 B8 = <存貨5-6>的F欄的倒數第二格的值(其實C=ABD)
進貨 B9 = <進貨51-52>的F欄的倒數第二格的值

*減：期末存貨 B11 = <存貨5-6>的F欄的最後一格 (圖1的位置E)
(這邊就真的可以用 .Cells(.Count).End(xlUp).Value)

圖2下面有橘色部分，B35、B36、B37
其他收入：目前沒建立工作表，因為很少用到，但為了程式順利運作，可增設一空工作表名為<其他收入>
利息收入 B36 = <利息收入93-94>的G欄倒數第二格(圖1位置D)
拥金收入B37 = <佣金收入95-96>的G欄倒數第二格(圖1位置D)

原本G大的程式是設定A18~A30，實際可能是到A32，我可微調
(因為要上傳，有些東西我先刪掉)
但多了B8.B9.B11這三個不連續的，而且B11找的地方不一樣
B35、B36、B37，也是
如何讓這幾個也能判斷年月日，正常運作放資料，我就不會改了
哈囉~大家好呀

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
54#
發表於 2014-2-16 08:23 | 只看該作者
回復 53# iceandy6150
[問題二] 待你附檔
[問題一] 如下
  1. For i = 1 To Rng(1).Count
  2.         Sh = Filter(Ar, Trim(Rng(1).Cells(i)), True)
  3.         'Filter 函數 傳回一個從零開始的陣列，該陣列包含基於指定篩選準則的一個字串陣列的子集。
  4.         For Each E In Sh
  5.             With Sheets(E)            '有"費用項目"名稱的 工作表
  6.                 Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows) '核對年度
  7.                 If Not Rng(2) Is Nothing Then
  8.                     Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole)                '搜尋月份
  9.                     If Not Rng(2) Is Nothing Then Set Rng(2) = Rng(2).Resize(4, 100).Find("本月合計", lookat:=xlPart)              '搜尋本月合計
  10.                     'Rng(2).Resize(4,100):找到的月份位置.Resize(4,100):擴充範圍(4列,100欄)
  11.                     If Not Rng(2) Is Nothing Then
  12.                         Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("C1")                  'Range("C1")金額位置:本月合計的第3欄
  13.                     End If
  14.                 End If
  15.             End With
  16.         Next
  17.     Next
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
55#
發表於 2014-2-16 11:28 | 只看該作者
本帖最後由 iceandy6150 於 2014-2-16 11:33 編輯

回復 54# GBKEE

感謝G大

再次上傳檔案，需求如#53篇所述



圖中紅色箭頭要取的值較為特殊，是該工作表最下面的總結

謝謝


附上檔案
總分類帳-上傳用.rar (111.31 KB)
哈囉~大家好呀

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
56#
發表於 2014-2-17 07:41 | 只看該作者
回復 55# iceandy6150
銷貨收入:要合計哪些工作表的儲存格?
期初存貨:要合計哪些工作表的儲存格?
進    貨:要合計哪些工作表的儲存格?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xlMon As Integer, xlYear As String, A As Variant, E As Variant
  4.     Dim Rng(1 To 2) As Range, Rng_Ar(), Ar(), i As Integer, Sh As Variant
  5.     With Sheets("損益表")
  6.         xlYear = Mid(.[a3], InStrRev(.[a3], "至") + 1, InStrRev(.[a3], "年") - InStrRev(.[a3], "至"))
  7.         'xlYear : 損益表的年度
  8.         xlMon = Mid(.[a3], InStrRev(.[a3], "年") + 1, InStrRev(.[a3], "月") - InStrRev(.[a3], "年") - 1)
  9.         'xlMon : 損益表的月份

  11.         Set Rng(1) = .[A18:A32,A35:A37]                 '*****  支出,收入 ****
  12.         
  13.     End With
  14.     ReDim Ar(1 To Sheets.Count)                         '陣列:元素數 = Sheets.Count
  15.     For i = 1 To Sheets.Count
  16.         Ar(i) = Sheets(i).Name                          '陣列:元素導入 Sheets.Name
  17.     Next
  18.      For Each A In Rng(1).Areas                         '支出,收入不在連續的範圍
  19.                          'Areas 屬性 傳回 Areas 集合，此集合代表多重範圍中的所有範圍。唯讀。
  20.         ReDim Rng_Ar(1 To A.Count)                      '陣列:元素數 = 費用項目數
  21.         For i = 1 To A.Count
  22.             Sh = Filter(Ar, Trim(A.Cells(i)), True)
  23.             'Filter 函數 傳回一個從零開始的陣列，該陣列包含基於指定篩選準則的一個字串陣列的子集。
  24.             For Each E In Sh
  25.                 With Sheets(E)            '有"費用項目"名稱的 工作表
  26.                     Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows) '核對年度
  27.                     If Not Rng(2) Is Nothing Then
  28.                         Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole)                '搜尋月份
  29.                         If Not Rng(2) Is Nothing Then Set Rng(2) = Rng(2).Resize(4, 100).Find("本月合計", lookat:=xlPart)              '搜尋本月合計
  30.                         'Rng(2).Resize(4,100):找到的月份位置.Resize(4,100):擴充範圍(4列,100欄)
  31.                         If Not Rng(2) Is Nothing Then
  32.                             If InStr(E, "收入") Then
  33.                                 Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("D1")          '貸  方 'Range("D1")金額位置:本月合計的第4欄
  34.                             Else
  35.                                 Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("C1")          '借  方 'Range("C1")金額位置:本月合計的第3欄
  36.                             End If
  37.                         End If
  38.                     End If
  39.                 End With
  40.             Next
  41.         Next
  42.         A.Offset(, 1) = Application.WorksheetFunction.Transpose(Rng_Ar)
  43.         'Transpose(轉置) : 一維陣列(橫式) 轉換為 二維陣列(這裡變一列直式)
  44.     Next
  45. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
57#
發表於 2014-2-17 19:05 | 只看該作者
本帖最後由 iceandy6150 於 2014-2-17 19:07 編輯

回復 56# GBKEE


    G大您真厲害，如果工作表是XX費用就是支出(借方)，是找F欄
   如果XX收入就是(貸方)，是找G欄。
  
    關於幾個不清楚的點

期初存貨： B8 = <存貨5-6>的F欄的倒數第二格的值                              

進貨： B9 = <進貨51-52>的F欄的倒數第二格的值

減：期末存貨： B11 = <存貨5-6>的F欄的"最後一格 "

銷貨收入：C6 = <銷貨收入>的F欄的倒數第二格的值

我把範圍改成 Set Rng(1) = .[A6,A8:A9,A11,A18:A32,A35:A37] 但是不太對  

有一個要放在C6卻放到B6，B8、B9放到B9、B10

再請大大幫我修一下

謝謝，感恩

總分類帳-上傳用.rar (120.03 KB)
哈囉~大家好呀

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
58#
發表於 2014-2-18 15:25 | 只看該作者
回復 57# iceandy6150
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xlMon As Integer, xlYear As String, A As Variant, E As Variant, Ay As String
  4.     Dim Rng(1 To 2) As Range, Rng_Ar(), Ar(), i As Integer, Sh As Variant, X As Integer
  5.     ReDim Ar(1 To Sheets.Count)                         '陣列:元素數 = Sheets.Count
  6.     For i = 1 To Sheets.Count
  7.         Ar(i) = Sheets(i).Name                          '陣列:元素導入 Sheets.Name
  8.     Next
  9.     With Sheets("損益表")
  10.         xlYear = Mid(.[a3], InStrRev(.[a3], "至") + 1, InStrRev(.[a3], "年") - InStrRev(.[a3], "至"))
  11.         'xlYear : 損益表的年度
  12.         xlMon = Mid(.[a3], InStrRev(.[a3], "年") + 1, InStrRev(.[a3], "月") - InStrRev(.[a3], "年") - 1)
  13.         'xlMon : 損益表的月份
  14.         Set Rng(1) = .[A6,A8,A9,A11,A18:A32,A35:A37]
  15.         ''6個範圍: 銷貨收入,進貨,期末存貨,減：期末存貨,支出,收入 ****
  16.     End With
  17.      For Each A In Rng(1).Areas   'Areas 屬性 傳回 Areas 集合，此集合代表多重範圍中的所有範圍。唯讀
  18.         If InStr(A.Cells(1), "存貨") Then Ay = "存貨" Else Ay = ""
  19.         '例外設定: 期初存貨,期末存貨,的工作表是"存貨??_??"
  20.         ReDim Rng_Ar(1 To A.Count)                      '陣列:元素數 = 費用項目數
  21.         For i = 1 To A.Count
  22.             Sh = Filter(Ar, IIf(Ay = "", Trim(A.Cells(i)), Ay), True)
  23.             If A.Cells(i) = "" Then Sh = Array()   '防呆
  24.             'Filter 函數 傳回一個從零開始的陣列，該陣列包含基於指定篩選準則的一個字串陣列的子集。
  25.             For Each E In Sh
  26.                 With Sheets(E)            '有"費用項目"名稱的 工作表
  27.                     Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows) '核對年度
  28.                     If Not Rng(2) Is Nothing Then Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole)             '搜尋月份
  29.                     If Not Rng(2) Is Nothing Then
  30.                         X = 1
  31.                         Do
  32.                             If Rng(2).Offset(X).Row > .Cells(.Rows.Count, "D").End(xlUp).Row Then Exit Do
  33.                             If Rng(2).Offset(X) <> Rng(2) And Rng(2).Offset(X) <> "" Then Exit Do
  34.                             X = X + 1
  35.                         Loop
  36.                         'Rng(2).Resize(X, 9) : 月份的範圍
  37.                         If InStr(E, "收入") Then
  38.                             Set Rng(2) = Rng(2).Resize(X, 9).Find("本月合計", lookat:=xlPart) '搜尋本月合計
  39.                             If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("D1")
  40.                             '貸  方 'Range("D1")金額位置:本月合計的第4欄
  41.                         Else
  42.                             If Trim(A.Cells(i)) = "減：期末存貨" Then
  43.                                 With Rng(2).Resize(X, 9)
  44.                                     Rng_Ar(i) = Rng_Ar(i) + .Cells(.Rows.Count, 6)
  45.                                     '借方:當月份<存貨5-6>的F欄的.End(xlDown) :"最後一格 "
  46.                                 End With
  47.                             Else
  48.                                 Set Rng(2) = Rng(2).Resize(X, 9).Find("本月合計", lookat:=xlPart) '搜尋本月合計
  49.                                 If Not Rng(2) Is Nothing Then Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("C1")
  50.                                 '借方 'Range("C1")金額位置:本月合計的第3欄
  51.                             End If
  52.                         End If
  53.                     End If
  54.                     
  55.                 End With
  56.             Next
  57.         Next
  58.         A.Offset(, IIf(Trim(A.Cells(1)) = "銷貨收入", 2, 1)) = Application.WorksheetFunction.Transpose(Rng_Ar)
  59.         'Transpose(轉置) : 一維陣列(橫式) 轉換為 二維陣列(這裡變一列直式)
  60.     Next
  61. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
59#
發表於 2014-2-18 22:23 | 只看該作者
回復 58# GBKEE

感謝G大幫忙

測試都能正常運作

程式相當有深度，要能瞭解可能有點久

再次感謝，Thank you!
哈囉~大家好呀

TOP

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
123456
返回列表 上一主題