- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
2#
發表於 2014-6-9 08:54
| 只看該作者
回復 1# leiru
公式我不太會,
VBA試試看:- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim sh, sh2 As Worksheet
- Dim Rng As Range
- Dim i, lastRow As Integer
- Set sh = Sheets("報表列印")
- Set sh2 = Sheets("總表")
- Set Rng = sh.Range("B1:B2")
- If Not Intersect(Target, Rng) Is Nothing Then '限定觸動 Worksheet_Change 的範圍為 sh.Range("B1:B2")
- If sh.[B1] = "" Then '如果 銷帳起日是空白,
- Exit Sub '則跳離
- ElseIf sh.[B2] <> "" And sh.[B2] < sh.[B1] Then '如果 銷帳起、迄日均不是空白, 但銷帳起日大於銷帳迄日,
- MsgBox "銷帳起日應小於銷帳迄日" & Chr(10) & "請查明再作!!", vbCritical '則示警,
- Exit Sub '再跳離
- End If
-
- sh.[C7].Resize(6, 4) = ""
- With sh2
- '下列10列, 只有資料亂掉時, 才需再執行一次
- '.[BG6] = "=MATCH(報表列印!B1,yy,0)" '銷帳起日 在"總表"的列號
- '.[BG7] = "=MATCH(報表列印!B2,yy,0)" '銷帳迄日 在"總表"的列號
- '.[BJ1] = "=SUM(BJ3:BJ368)" '筆數加總
- '.[BK1] = "=SUM(BK3:BK368)" '發票金額加總
- '.[BL1] = "=SUM(BL3:BL368)" '手續費加總
- '.[B2:E2].Copy .[BB2] '進階篩選準則 的標題
- '.[B2].Copy .[BG2]
- '.[BG3] = "<>" '進階篩選準則→去除 報表編號 是空白的儲存格
- 'sh.[E13].Resize(6, 4) = "=SUM(E7:E12)"
- 'sh.[F13].Resize(6, 4) = "=SUM(F7:F10,F12)"
-
- If sh.[B2] <> "" Then '如果 銷帳迄日 不是空白
- sh.[A3] = "=""台灣分公司 銷帳日： ""&TEXT($B1, ""yyyy/mm/dd"")&"" ~ ""&TEXT($B2, ""yyyy/mm/dd"")&"" 非記欠冊報數"""
- .[BB3].Resize(400, 4) = ""
- For i = 0 To 5
- .[BI3].Resize(400, 4) = ""
- .Cells(.[BG6], 1).Offset(0, i * 4 + 1).Resize(.[BG7] - .[BG6] + 1, 4).Copy .[BB3] '將欲篩選範圍 複製到篩選表
- '去除空列之進階篩選
- .[BB2].Resize(.[BG7] - .[BG6] + 2, 4).AdvancedFilter Action:=xlFilterCopy, _
- CriteriaRange:=.Range("BG2:BG3"), CopyToRange:=.Range("BI2:BL2"), Unique:=True
- If .[BI3] = "" Then
- sh.Cells(i + 7, 3).Resize(1, 4) = "'-"
- Else
- lastRow = .[BI200].End(xlUp).Row
- sh.Cells(i + 7, 3).FormulaR1C1 = "=總表!R3C61 & ""~"" & 總表!R" & lastRow & "C61" '報表編號
- sh.Cells(i + 7, 3).Copy
- sh.Cells(i + 7, 3).PasteSpecial Paste:=xlPasteValues '將公式轉成值
- .[BJ1].Resize(1, 3).Copy
- sh.Cells(i + 7, 4).PasteSpecial Paste:=xlPasteValues '貼上 筆數加總、發票加總、手續費加總
- End If
- Next
- Else '否則, 銷帳迄日 是空白
- sh.[A3] = "=""台灣分公司 銷帳日： ""&TEXT($B1, ""yyyy/mm/dd"")&"" ~ 非記欠冊報數"""
- For i = 0 To 5
- If .Cells(.[BG6], 1).Offset(0, i * 4 + 1) = "" Then
- sh.Cells(i + 7, 3).Resize(1, 4) = "'-"
- Else
- .Cells(.[BG6], 1).Offset(0, i * 4 + 1).Resize(1, 4).Copy
- sh.Cells(i + 7, 3).PasteSpecial Paste:=xlPasteValues
- End If
- Next
- End If
- End With
- sh.[B1].Select
- End If
- End Sub
 |
|
