janejacky

中學生 Rank: 2

帖子: 45
主題: 13
精華: 0
積分: 107
點名: 0
作業系統: XP
軟體版本: EXCEL2003
閱讀權限: 20
性別: 女
來自: 台北
註冊時間: 2010-12-31
最後登錄: 2024-7-2

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2011-5-8 11:37 | 只看該作者

如何做跨頁出貨單歷史統計

1.如何在出貨單歷史統計表中顯示出貨單資料

2.出貨單統計完後當日還可繼續輸入第2筆不同客戶的資料也會繼續顯示在出貨單歷史統計表中

要如何才能做出來ㄋ

出貨單歷史統計.rar (3.3 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2011-5-8 15:45 | 只看該作者

本帖最後由 GBKEE 於 2011-5-8 20:01 編輯

回復 1# janejacky

更正:
試試看

Sub Ex()
Dim D(2) As Object, R As Variant, AR()
Set D(0) = CreateObject("Scripting.Dictionary")
Set D(1) = CreateObject("Scripting.Dictionary")
Set D(2) = CreateObject("Scripting.Dictionary")
With Sheets("出貨單")
For Each R In .Range(.[B12], .[G29]).Rows '出貨單內容範圍-> 的整列
If Application.CountA(R) = 6 Then '資料要齊全
AR = Array(.[G4].Text, .[G5], .[B5], R.Cells(1, 1), R.Cells(1, 2), R.Cells(1, 3), R.Cells(1, 5), R.Cells(1, 6))
D(1)(Join(AR, ",")) = AR
End If
Next
End With
With Sheets("出貨單歷史統計")
For Each R In .Range(.[A3], .Cells(Rows.Count, "H").End(xlUp)).Rows
If Application.CountA(R) = 8 Then D(0)(Join(Application.Transpose(Application.Transpose(R.Value)), ",")) = ""
D(2)(R.Cells(1, 1) & R.Cells(1, 2)) = D(2)(R.Cells(1, 1) & R.Cells(1, 2)) + R.Cells(1, 8)
Next
For Each R In D(1).KEYS
If D(0).EXISTS(R) = False Then
With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Resize(, 8) = D(1)(R)
D(2)(.Cells(1) & .Cells(1, 2)) = D(2)(.Cells(1) & .Cells(1, 2)) + .Cells(1, 8)
End With
End If
Next
For Each R In .Range(.[A3], .Cells(Rows.Count, "A").End(xlUp))
If D(2).EXISTS(R & R(1, 2)) Then R(1, 9) = D(2)(R & R(1, 2))
Next
End With
Set D(0) = Nothing
Set D(1) = Nothing
Set R = Nothing
End Sub

複製代碼

TOP

janejacky

中學生 Rank: 2

帖子: 45
主題: 13
精華: 0
積分: 107
點名: 0
作業系統: XP
軟體版本: EXCEL2003
閱讀權限: 20
性別: 女
來自: 台北
註冊時間: 2010-12-31
最後登錄: 2024-7-2

3^#

發表於 2011-5-8 17:39 | 只看該作者

[版主管理留言]

GBKEE(2011/5/8 20:02): 已修正

我試過
但客戶名稱沒有到出貨統計表中ㄝ

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 259
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-30

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-5-9 00:03 | 只看該作者

回復 1# janejacky

試試附件

出貨單歷史統計.rar (12.57 KB)

Sub inputdata() '儲存資料
Dim Rng As Range, Ay()
With Sheet1
Set Rng = .Range("A12:A29")
If Application.CountA(Rng) > 0 Then
For Each a In Rng.SpecialCells(xlCellTypeConstants)
ar = Array(.[G5].Value, .[G4].Value, .[B5].Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
ReDim Preserve Ay(s)
Ay(s) = ar
s = s + 1
Next
cnt = .[G32].Value
With Sheet2
Set a = .[A65536].End(xlUp).Offset(1)
a.Resize(s, 8) = Application.Transpose(Application.Transpose(Ay))
a.Offset(s - 1, 8) = cnt
End With
End If
End With
End Sub
Function PaperNo(Rng As Range, mydate As Date, k) '流水編號
Set d = CreateObject("Scripting.Dictionary")
mystr = Format(mydate, "yyyymmdd")
If Application.CountA(Rng) > 0 Then
For Each a In Rng.SpecialCells(xlCellTypeConstants)
If Left(a, 8) = mystr Then d(Val(a)) = ""
Next
End If
If d.Count > 0 Then
PaperNo = IIf(k = 1, Format(Application.Max(d.keys) + 1, "00000000000"), Format(Application.Max(d.keys), "00000000000"))
Else
PaperNo = mystr & "001"
End If
End Function