Sub 變幅()
Dim str As String
Dim x As Integer
dirs = Dir("E:\??????????????\????\1\00??????" & "\*.xlsx")
Do While dirs <> ""
Set xlsx = Workbooks.Open("E:\??????????????\????\1\00??????" & "\" & dirs)
Dim c, d, e, f As Integer
c = 7 '???????
d = 8 '????????
e = 9 '??С???
f = 10 '??С????
g = 1 '?????????????
r = 2
m = 2
Sheets.Add
Sheets(2).Cells(1, c) = xlsx.Sheets(1).Cells(1, 2)
Sheets(2).Cells(1, d) = "時間"
Do While xlsx.Sheets(1).Cells(r, 1) <> ""
Sheets(2).Cells(m, c) = xlsx.Sheets(1).Cells(r, 2)
Sheets(2).Cells(m, d) = Year(xlsx.Sheets(1).Cells(r, 1))
Do While Year(xlsx.Sheets(1).Cells(r, 1)) = Sheets(2).Cells(m, d) And xlsx.Sheets(1).Cells(r, 1) <> ""
If Sheets(2).Cells(m, c) >= xlsx.Sheets(1).Cells(r, 2) Then
Sheets(2).Cells(m, c) = Cells(m, c)
Sheets(2).Cells(m, d) = Cells(m, d)
Else
Sheets(2).Cells(m, c) = xlsx.Sheets(1).Cells(r, 2)
Sheets(2).Cells(m, d) = Year(xlsx.Sheets(1).Cells(r, 1))
End If
r = r + 1
Sheets(2).Cells(m, 11) = Cells(m, 7) - Cells(m, 9) '11??????
Loop
m = m + 1
Loop
m = 2
r = 2
Do While xlsx.Sheets(1).Cells(r, 1) <> ""
Sheets(2).Cells(m, e) = xlsx.Sheets(1).Cells(r, 2)
Sheets(2).Cells(m, f) = Year(xlsx.Sheets(1).Cells(r, 1))
Do While Year(xlsx.Sheets(1).Cells(r, 1)) = Cells(m, f) And xlsx.Sheets(1).Cells(r, 1) <> "" '?????????????
If Sheets(2).Cells(m, e) <= xlsx.Sheets(1).Cells(r, 2) Then
Sheets(2).Cells(m, e) = Cells(m, e)
Sheets(2).Cells(m, f) = Cells(m, f)
Else
Sheets(2).Cells(m, e) = xlsx.Sheets(1).Cells(r, 2)
Sheets(2).Cells(m, f) = Year(xlsx.Sheets(1).Cells(r, 1))
End If
r = r + 1
Loop
m = m + 1
Loop
xlsx.Close True
dirs = Dir
Loop
End Sub
顯示錯誤為
程序呼叫或引數無效（錯誤 5）
2017/06/08
無法完成呼叫的某一部分。 此錯誤的原因和解決方案如下：
引數可能超出允許值的范圍。 例如， Sin 函式只能接受特定范圍內的值。 可以接受小于 2,147,483,648 的正引數，而 2,147,483,648 則會生成此錯誤。
檢查引數允許的范圍。
如果嘗試呼叫在當前平臺上無效的程序，也會出現此錯誤。 例如，有些程序僅對 Microsoft Windows 或 Macintosh 等有效。
檢查平臺特定的程序資訊。
有關其他資訊，選擇有問題的項并按 F1（在 Windows 中）或 HELP（在 Macintosh 上）。
支持和反饋
有關于 Office VBA 或本檔案的疑問或反饋？ 請參閱 Office VBA 支持和反饋，獲取有關如何接收支持和提供反饋的指南。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/28644.html
標籤：VBA