Andy2483

回復 10# lee88


    謝謝前輩
學習到多欄儲存格進階篩選的方法,心得註解如下:

Option Explicit
Sub TEST_lee88()
Dim Sh As Worksheet, Rng As Range, i As Integer
'↑宣告變數:Sh是 工作表變數,Rng是 儲存格變數,i是 短整數
Set Sh = Sheets("分類帳")
'↑令Sh是 "分類帳"工作表
With Sheets("結果")
'↑以下是關於 "結果"工作表的程序
   .Cells.Clear
   '↑清除全部工作表
   Set Rng = .[a1]
   '↑令Rng是 "結果"工作表的[A1]儲存格
   Sh.Range("A:A").AdvancedFilter xlFilterCopy, , .[Z1], True
   '↑令"分類帳"工作表 A欄做進階篩選到 "結果"工作表的[Z1]儲存格
   'https://learn.microsoft.com/zh-tw/office/vba/api/excel.range.advancedfilter
   Sh.Range("A1,d1").Copy .[aa1]
   '↑令"分類帳"工作表[A1,D1]儲存格集複製到 "結果"工作表的[AA1]儲存格
   .[ab2] = "=" & """<>" & "    本 日 合 計"""
   '填[摘要]入準則 條件
   '↑令"結果"工作表的[AB2]儲存格值是 公式:="<>    本 日 合 計"
   i = 2
   '↑令i這短整數是 2
   Do While .[Z1].Cells(i) <> ""
   '↑設無線迴圈!當 "結果"工作表的[Z1]儲存格向下i變數格的儲存格值不是 ""空字元,這條件下就繼續執行
   'https://learn.microsoft.com/zh-tw/dotnet/visual-basic/language-reference/statements/do-loop-statement
      .Range("aa2," & Rng.Address) = .[Z1].Cells(i)
      '↑令[AA2]與Rng儲存格變數這兩個 儲存格值是 "結果"工作表的[Z1]儲存格向下i變數格的儲存格值
       Sh.Range("B1:H1").Copy Rng.Cells(2)
       '↑令"分類帳"工作表[B1:H1]儲存格複製到 Rng儲存格變數的下一格
       Sh.Range("a:H").AdvancedFilter xlFilterCopy, .[aa1:ab2], Rng.Cells(2).Resize(1, 7)
       '進階篩選
       '↑令"分類帳"工作表[A:H]儲存格做 進階篩選:
       '準則1:明細科目_幣別是Z欄各個i變數項目
       '準則2:摘要 "<>    本 日 合 計"
       Set Rng = Rng.End(xlDown).Offset(2)
       '↑令Rng這儲存格變數是自身儲存格往下探到的最後有內容儲存格再往下邊移2格的儲存格
       i = i + 1
   Loop
End With

mdr0465

回復 11# Andy2483
多謝兩位輩的悉心教導, 謝謝

singo1232001

回復 12# mdr0465


    感謝借此題練習 附上檔案

Sub 分類()
With CreateObject("adodb.connection"): V = Application.Version:
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("結果"): Set s1 = Sheets("分類帳")
ar = s1.Range("b1:H1")
tx = Join(Application.Index(ar, 1, 0), ",")
Set rs = .Execute("select distinct " & s1.[A1] & " from [分類帳$A1:A]")
rr = rs.getrows(, , "明細科目_幣別")
s.Cells.ClearContents
For Each Z In rr
r = s.Cells(Rows.Count, 1).End(3).Row + 2
s.Cells(r, 1) = Z
s.Cells(r + 1, 1).Resize(1, UBound(ar, 2)) = ar
q = "select " & tx & " from [分類帳$A1:H] where 明細科目_幣別 = '" & Z & "' and 摘要 not like '%本%日%合%計%' and 摘要 not like '%本%年%累%計%'"
s.Cells(r + 2, 1).CopyFromRecordset .Execute(q)
Next
s.Rows("1:2").Delete Shift:=xlUp
r = s.Cells(Rows.Count, 1).End(3).Row
s.Cells(1, 1).Resize(r, 7).Borders.LineStyle = 1
End With
End Sub

Andy2483

回復 13# singo1232001


    謝謝前輩
請教前輩:
是不是要學過SQL、資料庫,才能了解此程式碼的意思?
謝謝前輩解惑

singo1232001

回復 14# Andy2483


    是的
用vba 調用sql來處理excel某些資料整理的問題