- 帖子
- 11
- 主題
- 1
- 精華
- 0
- 積分
- 17
- 點名
- 0
- 作業系統
- WindowsXP
- 軟體版本
- 2003
- 閱讀權限
- 10
- 性別
- 女
- 註冊時間
- 2011-9-29
- 最後登錄
- 2013-5-22
 
|
4#
發表於 2013-5-8 10:34
| 只看該作者
請問GBKEE版大，如果我工作表都有特殊的命名方式（日期+投入量），可否以陣列方式將之前新增的檔案刪除，下面是我的程式碼：
PS.我知道不能用dir來指定工作頁，不過目前我還沒想到其他方式- Sub 投入量()
- Set MyBook = ThisWorkbook
- Set MySht = MyBook.Sheets("報表")
- MyPath = MyBook.Path & "\投入量\"
-
- '刪除工作頁
- Dim FindSht( ) As String
- FindSht( ) = Dir(MyBook.Sheet("*投入量"))
- Do While FindSht( ) <> ""
- FindSht( ).Delete
- Loop
-
- '匯入資料
- Dim str(1), FindFile(1) As String, WbDate(1) As Date
- For i = 3 To 95
- If i Mod 3 = 0 Then
- If MySht.Cells(i, 1).Value <> "" Then
- WbDate(0) = MySht.Cells(i, 1).Value
- WbDate(1) = MySht.Cells(i, 1).Value + 1
- str(0) = Format(WbDate(0), "mmddyyyy")
- str(1) = Format(WbDate(1), "mmddyyyy")
- FindFile(0) = Dir(MyPath & "d_ic1_" & str(0) & "_0200.xls") '開date(0)檔案
- If FindFile(0) <> "" Then
- Workbooks.Open MyPath & FindFile(0)
- Windows("d_ic1_" & str(0) & "_0200.xls").Activate
- Range("C35:F35").Select
- Application.CutCopyMode = False
- Selection.Copy
-
- Windows("尖離峰發電及焚化量統計.xls").Activate
- Worksheets.Add
- ActiveSheet.Name = Mid(str(0), 1, 4) + "投入量"
- Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Workbooks(FindFile(0)).Close SaveChanges:=False
- Else
- MsgBox "找不到檔案: " & "d_ic1_" & str(0) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub 'Exit For會產生next無for錯誤!!
- Application.ScreenUpdating = False
- End If
-
- FindFile(1) = Dir(MyPath & "d_ic1_" & str(1) & "_0200.xls") '開date(1)檔案
- If FindFile(1) <> "" Then
- Workbooks.Open MyPath & FindFile(1)
- Windows("d_ic1_" & str(1) & "_0200.xls").Activate
- Range("C12:F34").Select
- Application.CutCopyMode = False
- Selection.Copy
- Windows("尖離峰發電及焚化量統計.xls").Activate
- Sheets(Mid(str(0), 1, 4) + "投入量").Activate
- Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Range("A1").FormulaR1C1 = "Hour"
- Range("A2").FormulaR1C1 = "00:00"
- Range("A3").FormulaR1C1 = "01:00"
- Range("A2:A3").Select
- Selection.AutoFill Destination:=Range("A2:A25")
-
- Range("B1").FormulaR1C1 = "#1爐投入量"
- Range("C1").FormulaR1C1 = "#2爐投入量"
- Range("D1").FormulaR1C1 = "#3爐投入量"
- Range("E1").FormulaR1C1 = "#4爐投入量"
-
- Range("G1").FormulaR1C1 = "值別"
- Range("G2").FormulaR1C1 = "1"
- Range("G3").FormulaR1C1 = "2"
- Range("G4").FormulaR1C1 = "3"
- Range("H1").FormulaR1C1 = "#1爐投入量"
- Range("H2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
- Range("H3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
- Range("H4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
- Range("I1").FormulaR1C1 = "#2爐投入量"
- Range("I2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
- Range("I3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
- Range("I4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
- Range("J1").FormulaR1C1 = "#3爐投入量"
- Range("J2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
- Range("J3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
- Range("J4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
- Range("K1").FormulaR1C1 = "#4爐投入量"
- Range("K2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
- Range("K3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
- Range("K4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
- Range("L1").FormulaR1C1 = "附註"
- Range("L2").FormulaR1C1 = "23:00~08:00"
- Range("L3").FormulaR1C1 = "08:00~15:00"
- Range("L4").FormulaR1C1 = "15:00~23:00"
-
- Workbooks(FindFile(1)).Close SaveChanges:=False
- Else
- MsgBox "找不到檔案: " & "d_ic1_" & str(1) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub
- Application.ScreenUpdating = False
- End If
- End If
- End If
- Next
- End Sub
|
|
發表於 2011-9-25 21:47
| 
