Board logo

標題: 特定期間跨表加總 [打印本頁]
作者: leiru    時間: 2014-6-6 11:13     標題: 特定期間跨表加總

當"報表列印"工作表B1輸入銷帳起日(2014/05/01)；B2輸入銷帳迄日(2014/05/31)，
問題一：
A3顯示：台灣分公司　銷帳日：  2014/5/1 ~  2014/5/31 非記欠冊報數
問題二：   
C7：F12去抓取"總表"工作表A欄內符合日期之所對應的B欄至Y欄
PS.說明：C7儲存格，【中信】"報表編號"呈現方式：1030501~1030525
問題三：
若只輸入銷帳起日，也就是只輸入B1(2014/05/01)，B2不輸入，而A3希望顯示：台灣分公司　銷帳日：  2014/5/1　非記欠冊報數
作者: yen956    時間: 2014-6-9 08:54

回復 1# leiru
公式我不太會,
VBA試試看:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim sh, sh2 As Worksheet
  3.     Dim Rng As Range
  4.     Dim i, lastRow As Integer
  5.     Set sh = Sheets("報表列印")
  6.     Set sh2 = Sheets("總表")
  7.     Set Rng = sh.Range("B1:B2")
  8.     If Not Intersect(Target, Rng) Is Nothing Then    '限定觸動 Worksheet_Change 的範圍為 sh.Range("B1:B2")
  9.         If sh.[B1] = "" Then     '如果 銷帳起日是空白,
  10.             Exit Sub             '則跳離
  11.         ElseIf sh.[B2] <> "" And sh.[B2] < sh.[B1] Then    '如果 銷帳起、迄日均不是空白, 但銷帳起日大於銷帳迄日,
  12.             MsgBox "銷帳起日應小於銷帳迄日" & Chr(10) & "請查明再作!!", vbCritical   '則示警,
  13.             Exit Sub                                                                 '再跳離
  14.         End If
  15.    
  16.         sh.[C7].Resize(6, 4) = ""
  17.         With sh2
  18.            '下列10列, 只有資料亂掉時, 才需再執行一次
  19.            '.[BG6] = "=MATCH(報表列印!B1,yy,0)"   '銷帳起日 在"總表"的列號
  20.            '.[BG7] = "=MATCH(報表列印!B2,yy,0)"   '銷帳迄日 在"總表"的列號
  21.            '.[BJ1] = "=SUM(BJ3:BJ368)"            '筆數加總
  22.            '.[BK1] = "=SUM(BK3:BK368)"            '發票金額加總
  23.            '.[BL1] = "=SUM(BL3:BL368)"            '手續費加總
  24.            '.[B2:E2].Copy .[BB2]                  '進階篩選準則 的標題
  25.            '.[B2].Copy .[BG2]
  26.            '.[BG3] = "<>"                         '進階篩選準則→去除 報表編號 是空白的儲存格
  27.            'sh.[E13].Resize(6, 4) = "=SUM(E7:E12)"
  28.            'sh.[F13].Resize(6, 4) = "=SUM(F7:F10,F12)"
  29.       
  30.             If sh.[B2] <> "" Then   '如果 銷帳迄日 不是空白
  31.                 sh.[A3] = "=""台灣分公司　銷帳日： ""&TEXT($B1, ""yyyy/mm/dd"")&"" ~ ""&TEXT($B2, ""yyyy/mm/dd"")&"" 非記欠冊報數"""
  32.                 .[BB3].Resize(400, 4) = ""
  33.                 For i = 0 To 5
  34.                     .[BI3].Resize(400, 4) = ""
  35.                     .Cells(.[BG6], 1).Offset(0, i * 4 + 1).Resize(.[BG7] - .[BG6] + 1, 4).Copy .[BB3]    '將欲篩選範圍 複製到篩選表
  36.                     '去除空列之進階篩選
  37.                     .[BB2].Resize(.[BG7] - .[BG6] + 2, 4).AdvancedFilter Action:=xlFilterCopy, _
  38.                              CriteriaRange:=.Range("BG2:BG3"), CopyToRange:=.Range("BI2:BL2"), Unique:=True
  39.                     If .[BI3] = "" Then
  40.                         sh.Cells(i + 7, 3).Resize(1, 4) = "'-"
  41.                     Else
  42.                         lastRow = .[BI200].End(xlUp).Row
  43.                         sh.Cells(i + 7, 3).FormulaR1C1 = "=總表!R3C61 & ""~"" & 總表!R" & lastRow & "C61"  '報表編號
  44.                         sh.Cells(i + 7, 3).Copy
  45.                         sh.Cells(i + 7, 3).PasteSpecial Paste:=xlPasteValues   '將公式轉成值
  46.                         .[BJ1].Resize(1, 3).Copy
  47.                         sh.Cells(i + 7, 4).PasteSpecial Paste:=xlPasteValues   '貼上 筆數加總、發票加總、手續費加總
  48.                     End If
  49.                 Next
  50.             Else                 '否則, 銷帳迄日 是空白
  51.                 sh.[A3] = "=""台灣分公司　銷帳日： ""&TEXT($B1, ""yyyy/mm/dd"")&"" ~  非記欠冊報數"""
  52.                 For i = 0 To 5
  53.                     If .Cells(.[BG6], 1).Offset(0, i * 4 + 1) = "" Then
  54.                         sh.Cells(i + 7, 3).Resize(1, 4) = "'-"
  55.                     Else
  56.                         .Cells(.[BG6], 1).Offset(0, i * 4 + 1).Resize(1, 4).Copy
  57.                         sh.Cells(i + 7, 3).PasteSpecial Paste:=xlPasteValues
  58.                     End If
  59.                 Next
  60.             End If
  61.         End With
  62.         sh.[B1].Select
  63.     End If
  64. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)