返回列表 上一主題 發帖

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

回復 39# iceandy6150
  1. Option Explicit
  2. Private Sub CommandButton2_Click()
  3.     Sheets("參照表").UsedRange.Columns(1).CreateNames True
  4.     With Sheets("Sheet1").Range("G2:G150").Validation
  5.         .Add Type:=xlValidateList, Formula1:="=" & Sheets("參照表").UsedRange.Cells(1)
  6.     End With
  7. End Sub
  8. Private Sub CommandButton4_Click()
  9.     Dim i As Integer, C As Range
  10.     For Each C In Sheets("Sheet1").UsedRange.Columns(7).Cells
  11.         If C = "" Then MsgBox ("有空格"): Exit Sub
  12.     Next
  13.     MsgBox ("無空格")
  14. End Sub
  15. Sub Ex()
  16.     Dim i As Integer
  17.     'UsedRange.RANGE("G:G") -> 已使用範圍的G欄會延伸到工作表的的底部
  18.     'UsedRange.Columns(7)   -> 僅已使用範圍第1欄範圍算起的第7欄範圍
  19.     For i = 1 To 3
  20.         With Sheets.Add(, Sheets(Sheets.Count))
  21.             If i = 1 Then
  22.                 .[F1,I5] = "AA"
  23.             ElseIf i = 2 Then
  24.                 .[D1,F5] = "AA"
  25.             Else
  26.                 .[D2,F5] = "AA"
  27.             End If
  28.             MsgBox .UsedRange.Address
  29.             MsgBox .UsedRange.Columns(5).Address
  30.             MsgBox .UsedRange.Range("E:E").Address        '.[D2,F5]->工作表第一列沒資料有錯誤
  31.         End With
  32.     Next
  33. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 41# iceandy6150
  1. Private Sub CommandButton2_Click()
  2.     Sheets("參照表").UsedRange.Columns(1).CreateNames True
  3.     With Sheets("Sheet1").Range("G2:G150").Validation
  4.         .Delete  '加上這行 如還有錯誤,請上傳檔案
  5.       '.Delete  2003版可不用.
  6.         .Add Type:=xlValidateList, Formula1:="=" & Sheets("參照表").UsedRange.Cells(1)
  7.     End With
  8. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 43# iceandy6150
OFFICE的版本不同
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 45# iceandy6150
  1. End 屬性 該物件代表包含來源範圍之區域結尾處的儲存格。等於按 END+向上鍵、END+向下鍵、END+向左鍵或 END+向右鍵。唯讀 Range 物件。
  2. expression.End (Direction)
  3. Direction    必選的 XlDirection 資料類型。要移往的方向。
  4. XlDirection 可以是這些 XlDirection 常數之一。
  5. xlDown
  6. xlToRight
  7. xlToLeft
  8. xlUp
複製代碼
  1. Sub Ex()
  2.     With ActiveSheet.Range("G:G")
  3.        MsgBox .Cells(.Count).End(xlUp).Address
  4.     End With
  5.     With ActiveSheet
  6.        MsgBox .Range("G" & .Rows.Count).End(xlUp).Address
  7.     End With
  8.     With ActiveSheet
  9.        MsgBox .Cells(.Rows.Count, "G").End(xlUp).Address
  10.     End With
  11.     With ActiveSheet
  12.        MsgBox .Cells(.Rows.Count, 7).End(xlUp).Address
  13.     End With
  14. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 47# iceandy6150
.Rows.Count : 傳回物件列的總數
.Range("G" & .Rows.Count) : 這儲存格是位於G欄最底部的列號
為什麼是 xlup ? (往上),不是 應該是xldown(往下)
Range("G" & .Rows.Count).End(xldown).Value  :還是最底部列的儲存格

請將檔案的範例上傳看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 49# iceandy6150
  1. '費用項目中 "津  貼",有空格,工作表名稱"津貼59-60"中沒空格
  2. '所有費用項目需與工作表名稱(費用項目??_??)一致
  3. '否則 Sh = Filter(Ar, Trim(Rng(1).Cells(i)), True) 會不正確'
  4. Option Explicit
  5. Sub Ex()
  6.     Dim xlMon As Integer, xlYear As String, E As Variant
  7.     Dim Rng(1 To 2) As Range, Rng_Ar(), Ar(), i As Integer, Sh As Variant
  8.     With Sheets("損益表")
  9.         xlYear = Mid(.[a3], InStrRev(.[a3], "至") + 1, InStrRev(.[a3], "年") - InStrRev(.[a3], "至"))
  10.         'xlYear : 損益表的年度
  11.         xlMon = Mid(.[a3], InStrRev(.[a3], "年") + 1, InStrRev(.[a3], "月") - InStrRev(.[a3], "年") - 1)
  12.         'xlMon : 損益表的月份
  13.         Set Rng(1) = .[A18:A30]                         '費用項目
  14.         ReDim Rng_Ar(1 To Rng(1).Count)                 '陣列:元素數 = 費用項目數
  15.     End With
  16.     ReDim Ar(1 To Sheets.Count)                         '陣列:元素數 = Sheets.Count
  17.     For i = 1 To Sheets.Count
  18.         Ar(i) = Sheets(i).Name                          '陣列:元素導入 Sheets.Name
  19.     Next
  20.     For i = 1 To Rng(1).Count
  21.         Sh = Filter(Ar, Trim(Rng(1).Cells(i)), True)
  22.         'Filter 函數 傳回一個從零開始的陣列,該陣列包含基於指定篩選準則的一個字串陣列的子集。
  23.         For Each E In Sh
  24.             With Sheets(E)                              '有"費用項目"名稱的 工作表
  25.                 Set Rng(2) = .[A:B].Find(xlYear, lookat:=xlWhole, LookIn:=xlValues) '核對年度
  26.                 If Not Rng(2) Is Nothing Then
  27.                     Set Rng(2) = .[a:a].Find(xlMon, lookat:=xlWhole)                '搜尋月份
  28.                     If Not Rng(2) Is Nothing Then
  29.                         Rng_Ar(i) = Rng_Ar(i) + Rng(2).Range("F1")                  'Range("F1"):金額位置
  30.                     End If
  31.                 End If
  32.             End With
  33.         Next
  34.     Next
  35.     Rng(1).Offset(, 1) = Application.WorksheetFunction.Transpose(Rng_Ar)
  36.     'Transpose(轉置) : 一維陣列(橫式) 轉換為 二維陣列(這裡變一列直式)
  37. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

回復 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 : 損益表的月份

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

TOP

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

        靜思自在 : 改變自己是自救,影響別人是救人。
返回列表 上一主題