返回列表 上一主題 發帖

[發問] excel報表跑巨集呈現Delay批與虛帳

本帖最後由 准提部林 於 2015-10-2 22:28 編輯

不好寫,看得眼花∼∼
1.欄位少了〔QVS〕欄,請補上;〔範例報表〕M:W應共11個欄位
2.〔日期〕欄或其他欄位屬〔文字格式〕者,請事先設定,否則資料格式會改變,
  另,〔日期〕沒有年份,遇跨年比對會有問題,目前先預判〔INPUT〕日期不會大于〔今日〕_即未來日!
3.Select Case 用的是〔欄位〕區別,自行去認各不同資料群組的欄號區域
4.程式碼看起來有點複雜,但肯定都是基本語法,請自行參酌視實際修改,恕不再註解及說明
 
  1. Sub 執行()
  2. Dim Arr, Brr(0, 1 To 32), j&, Jm%, k&, Km%, TT$, QD, QA, QB
  3. Call 清除
  4. Dim X As New Application
  5. With X.Workbooks.Open(ThisWorkbook.Path & "\範例報表.xls", ReadOnly:=True)
  6.      Arr = .Sheets(1).UsedRange.Columns("A:BM").Cells
  7.      .Close 0
  8. End With
  9. For j = 9 To UBound(Arr)
  10.   If Arr(j, 1) = "PKG Type :" Then TT = Arr(j, 4)
  11.   If Arr(j, 1) Like "#######" = False Then GoTo 101
  12.   
  13.   QD = Date
  14.   If IsDate(Arr(j, 9)) Then QD = DateValue(Arr(j, 9))
  15.   If QD > Date Then QD = DateValue(Year(Date) - 1 & "/" & Arr(j, 9))
  16.   If Date - QD > 3 Then QD = 1 Else QD = 0
  17.  
  18.   QA = 0: QB = 0: Km = 1: Brr(0, 1) = TT: Brr(0, 32) = Date
  19.   For k = 1 To UBound(Arr, 2)
  20.     Select Case k
  21.       Case 1, 3, 4, 9, 10
  22.         Jm = 1
  23.       Case 13 To 23
  24.         Jm = 1: QA = QA + Val(Arr(j, k))
  25.       Case 30 To 32, 35 To 39, 42 To 45, 50 To 65
  26.         QA = QA + Val(Arr(j, k))
  27.       Case 24 To 29, 33, 34, 40, 41, 46 To 49
  28.         Jm = 1: QA = QA + Val(Arr(j, k)): QB = QB + Val(Arr(j, k))
  29.     End Select
  30.     If Jm > 0 Then Km = Km + 1: Brr(0, Km) = Arr(j, k): Jm = 0
  31.   Next k
  32.   If QA > Arr(j, 10) Then ['Virtual Result'!A65536].End(xlUp)(2).Resize(1, 31) = Brr
  33.   If QB > 0 And QD = 1 Then ['Delay Result'!A65536].End(xlUp)(2).Resize(1, 32) = Brr
  34. 101: Next j
  35. Beep
  36. End Sub

  37. '=======================================
  38. Sub 清除()
  39. Sheets("Virtual Result").UsedRange.Offset(1, 0).ClearContents
  40. Sheets("Delay Result").UsedRange.Offset(1, 0).ClearContents
  41. End Sub
複製代碼

TOP

        靜思自在 : 不要小看自己,因為人有無限的可能。
返回列表 上一主題