[發問] 使用VBA或巨集進行累計次數

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2015-11-28 11:48 | 只看該作者

[發問] 使用VBA或巨集進行累計次數

本帖最後由 GBKEE 於 2015-11-28 12:01 編輯

使用VBA或巨集進行累計次數
1.按"載入累計表"會自動統計次數
2. 名稱說明: Tester No(欄位:A2) --> 機台編號       f12ad048(欄位:A4)--->機台號碼
3.累計次數說明:
A.欄位C4方式:指定機台f12ad048(欄位:A4) 比對工作表"summary" 欄位D3~D5000 有出現機台f12ad048
      再比對比對工作表"summary" 欄位F3~F5000 ，日期時間在11月01 日 00:00~07:59出現累計次數
B.欄位C5方式:指定機台f12ad048(欄位:A4) 比對工作表"summary" 欄位D3~D5000 有出現機台f12ad048
      再比對比對工作表"summary" 欄位F3~F5000 ，日期時間在11月01 日 08:00~15:59出現累計次數
C.欄位C6方式:指定機台f12ad048(欄位:A4) 比對工作表"summary" 欄位D3~D5000 有出現機台f12ad048
      再比對比對工作表"summary" 欄位F3~F5000 ，日期時間在11月01 日 16:00~23:59出現累計次數
D.欄位C7方式:指定機台f12ad048(欄位:A4) 比對工作表"summary" 欄位D3~D5000 有出現機台f12ad048
      再比對比對工作表"summary" 欄位F3~F5000 ，日期時間在11月01 日 00:00~23:59出現累計次數
4.將指定欄位完成統計累計次數
PS:如附件所示
請各位高手大哥協助....謝謝

累計次數.zip (598.13 KB)

附件

樓主熱帖

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

18^#

發表於 2015-12-1 20:56 | 只看該作者

回復 17# yen956
感謝yen956大大....測試OK.....謝謝

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

17^#

發表於 2015-12-1 09:11 | 只看該作者

回復 16# jeff5424
舊VBA Code沒刪乾淨!!
將第一列刪除即可.

http://www.mediafire.com/download/8t334h19m3lr82m/%E7%B4%AF%E8%A8%88%E6%AC%A1%E6%95%B8.rar

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

16^#

發表於 2015-11-30 20:11 | 只看該作者

回復 15# yen956
yen956 大大,我測試出現err(如圖所示),可以將excel檔嗎....謝謝

err.gif (477.73 KB)

err

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

15^#

發表於 2015-11-30 08:12 | 只看該作者

回復 14# jeff5424
可能是巨集安全性的問題,
將巨集安全性調低就可以了.

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

14^#

發表於 2015-11-29 20:22 | 只看該作者

回復 12# yen956
yen956 大大,我測試後不能用巨集/VBA,可以麻煩大大給我原始檔嗎....謝謝

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

13^#

發表於 2015-11-29 20:08 | 只看該作者

回復 9# hcm19522
感謝hcm19522大大的幫忙,我在測試正常.....謝謝

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

12^#

發表於 2015-11-29 17:54 | 只看該作者

請自行測試看看!!(資料太多)

Private Sub CommandButton1_Click()
Dim LastR As Integer, I As Integer
Dim Rng As Range, fAddr As String
Dim Col1 As Integer, Off1 As Integer, H1 As Integer
LastR = [D65536].End(xlUp).Row
[F2:AI73] = ""
For I = 2 To LastR Step 4
Set Rng = [A:A].Find(Cells(I, 4), Lookat:=xlWhole) '欄A 中尋找TesterNo
If Not Rng Is Nothing Then
fAddr = Rng.Address
Do
Col1 = Day(Rng.Offset(0, 1)) + 5
H1 = Hour(Rng.Offset(0, 1))
Off1 = IIf(H1 < 16, 1, 2)
If H1 < 8 Then Off1 = 0
Cells(I + Off1, Col1) = Cells(I + Off1, Col1) + 1
Cells(I + 3, Col1) = Cells(I + 3, Col1) + 1
Set Rng = [A:A].FindNext(Rng) '尋找下一個TesterNo
Loop Until fAddr = Rng.Address '直到下一個TesterNo的位置=第一個TesterNo的位置
End If
Next
End Sub

複製代碼

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

11^#

發表於 2015-11-29 13:04 | 只看該作者

本帖最後由准提部林於 2015-11-29 13:05 編輯

Sub TEST()
Dim i&, R&, C&, xD, xArea As Range, Arr, xR As Range, X&, Y&, Z%
C = [IV2].End(xlToLeft).Column
R = [B65536].End(xlUp).Row
Set xD = CreateObject("Scripting.Dictionary")
For i = 4 To R Step 4: xD(Cells(i, 1) & "") = i - 3: Next i　　'取得〔Tester No〕的〔列位〕
For i = 3 To C: xD(Format(Cells(2, i), "yyyy-mm-dd")) = i - 2: Next i　'取得日期的〔欄位〕
Set xArea = [C4].Resize(R - 3, C - 2)　'統計數值區
xArea.ClearContents: Arr = xArea　'清除統計，以Arr代出
　
For Each xR In Range([summary!D3], [summary!D65536].End(xlUp))
　　X = xD(xR.Value)　'〔Tester No〕的〔列位〕
　　Y = xD(Format(xR(1, 3), "yyyy-mm-dd"))　'日期的〔欄位〕
　　If X = 0 Or Y = 0 Then GoTo 101
　　Z = Int(Hour(xR(1, 3)) / 8)　'早午晚時段計算
　　Arr(X + Z, Y) = Arr(X + Z, Y) + 1　'累計時段次數
　　Arr(X + 3, Y) = Arr(X + 3, Y) + 1　'累計當日次數
101: Next
xArea = Arr
End Sub

帖子: 83
主題: 33
精華: 0
積分: 131
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2024-8-27

論壇贊助勳章

10^#

發表於 2015-11-29 12:56 | 只看該作者

回復 9# hcm19522
感謝hcm19522大大的幫忙,我在測試看看.....謝謝