- 帖子
- 40
- 主題
- 11
- 精華
- 0
- 積分
- 100
- 點名
- 0
- 作業系統
- Win8
- 軟體版本
- Office2013
- 閱讀權限
- 20
- 性別
- 男
- 來自
- Taiwan
- 註冊時間
- 2014-12-9
- 最後登錄
- 2021-7-2
 
|
解Bug
有上百個檔案 , 如附件中的"上華" , "光鈦"檔案 ,
擬以如下程式抄寫至"ReceiveList"檔案 ,
目前測試時 Msgbox file 正確 , 但 MsgBox LastRow 卻顯示 1048576 , 且程式中斷 ,
請問那裏有問題呀 ? TKS .
Sub M1()
Dim path$, file$, first$
path = "C:\Users\oliwa\Desktop\5-成本分析資料\10501進貨\"
file = Dir(path & "*.xls")
If file = "" Then Exit Sub
first = file
Do
MsgBox file
Workbooks.Open (path & file)
StartRow = Range("A1:A10").Find("發票號碼").Row + 1
CopyRow = Cells(1, "A").End(xlDown).Row
Range("A" & StartRow & ":K" & CopyRow).Select
Selection.Copy
Windows("ReceiveList.xlsm").Activate
LastRow = Cells(1, "A").End(xlDown).Row
MsgBox LastRow
Range("A" & LastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(path & file).Activate
ActiveWindow.Close
file = Dir
Loop While file <> "" And first <> file
ActiveWorkbook.Save
End Sub |
|
發表於 2016-9-25 20:12
| 
