- 帖子
- 2833
- 主題
- 10
- 精華
- 0
- 積分
- 2889
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-17
|
3#
發表於 2015-10-2 22:26
| 只看該作者
本帖最後由 准提部林 於 2015-10-2 22:28 編輯
不好寫，看得眼花∼∼
１．欄位少了〔QVS〕欄，請補上；〔範例報表〕Ｍ：Ｗ應共１１個欄位
２．〔日期〕欄或其他欄位屬〔文字格式〕者，請事先設定，否則資料格式會改變，
另，〔日期〕沒有年份，遇跨年比對會有問題，目前先預判〔INPUT〕日期不會大于〔今日〕＿即未來日！
３．Select Case 用的是〔欄位〕區別，自行去認各不同資料群組的欄號區域
４．程式碼看起來有點複雜，但肯定都是基本語法，請自行參酌視實際修改，恕不再註解及說明
- Sub 執行()
- Dim Arr, Brr(0, 1 To 32), j&, Jm%, k&, Km%, TT$, QD, QA, QB
- Call 清除
- Dim X As New Application
- With X.Workbooks.Open(ThisWorkbook.Path & "\範例報表.xls", ReadOnly:=True)
- Arr = .Sheets(1).UsedRange.Columns("A:BM").Cells
- .Close 0
- End With
- For j = 9 To UBound(Arr)
- If Arr(j, 1) = "PKG Type :" Then TT = Arr(j, 4)
- If Arr(j, 1) Like "#######" = False Then GoTo 101
-
- QD = Date
- If IsDate(Arr(j, 9)) Then QD = DateValue(Arr(j, 9))
- If QD > Date Then QD = DateValue(Year(Date) - 1 & "/" & Arr(j, 9))
- If Date - QD > 3 Then QD = 1 Else QD = 0
-
- QA = 0: QB = 0: Km = 1: Brr(0, 1) = TT: Brr(0, 32) = Date
- For k = 1 To UBound(Arr, 2)
- Select Case k
- Case 1, 3, 4, 9, 10
- Jm = 1
- Case 13 To 23
- Jm = 1: QA = QA + Val(Arr(j, k))
- Case 30 To 32, 35 To 39, 42 To 45, 50 To 65
- QA = QA + Val(Arr(j, k))
- Case 24 To 29, 33, 34, 40, 41, 46 To 49
- Jm = 1: QA = QA + Val(Arr(j, k)): QB = QB + Val(Arr(j, k))
- End Select
- If Jm > 0 Then Km = Km + 1: Brr(0, Km) = Arr(j, k): Jm = 0
- Next k
- If QA > Arr(j, 10) Then ['Virtual Result'!A65536].End(xlUp)(2).Resize(1, 31) = Brr
- If QB > 0 And QD = 1 Then ['Delay Result'!A65536].End(xlUp)(2).Resize(1, 32) = Brr
- 101: Next j
- Beep
- End Sub
- '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
- Sub 清除()
- Sheets("Virtual Result").UsedRange.Offset(1, 0).ClearContents
- Sheets("Delay Result").UsedRange.Offset(1, 0).ClearContents
- End Sub
|
|
發表於 2015-10-1 00:57
| 
