- 帖子
- 84
- 主題
- 15
- 精華
- 0
- 積分
- 123
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Office 2010
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台南市
- 註冊時間
- 2011-5-16
- 最後登錄
- 2022-9-17
|
拍謝~我的問題邏輯結構不夠具體造成"腦袋打結"~^.^
還是我給老師看全部的程式碼 這樣比較不會筆誤~^.^
Sub testall()
F = Application.GetOpenFilename("Excel 檔案(*.xls),*.xls")
If F = "False" Then Exit Sub
Workbooks.Open filename:=F
y = ActiveWorkbook.Name
Dim mtstr As String, Wb As Workbook
On Error Resume Next
myStr = "選取資料OK後按確定鍵"
Set k = Application.InputBox(myStr, Type:=8) 'data範圍
If Err Then Exit Sub
Set Wb = Workbooks.Add '開啟新活頁簿
ThisWorkbook.Activate
k.Copy Wb.ActiveSheet.[A3]
Set k = Nothing'釋放物件
Response = MsgBox("是 / 否繼續選取", vbYesNo)
Do Until Response <> vbYes
Windows(y).Activate'回到原選取檔案繼續選取
Set k = Application.InputBox(myStr, Type:=8) 'data範圍
k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '指定儲存格 貼上資料
Set k = Nothing'釋放物件
Response = MsgBox("是 / 否繼續選取", vbYesNo)
Loop
Application.DisplayAlerts = False'關閉訊息欄
Windows(y).Close' 關閉選取資料檔案
Application.DisplayAlerts = True'開啟訊息欄
Application.ScreenUpdating = False
Windows(Wb).Activate '顯示到新活頁簿檔案畫面
Windows("book1".xls).Activate '上面那行可以寫成這樣嘛?
Dim nX As Long, X As Long, I As Integer'以下是在新活頁簿執行
nX = [A65536].End(xlUp).Row
For X = nX To 4 Step -1
For I = 1 To 3
Rows(X).Insert
Next
Next
bb = (nX - 1) * 4 - 1
cc = 65536
Rows(bb & ":" & cc).Clear
Columns("n ") = Columns("n").Value'只顯示表格資料
Application.Dialogs(xlDialogSaveAs).Show (Format(Date, "yymmdd" & "-Tilt") & "-PDA" & ".xls")'另存新活頁簿檔名
Windows("程式檔").Close'關閉巨集撰寫檔案(因為我使用巨集小按鈕指定巨集來啟動)應該是老師說的"程式檔"皆再下層執行不要顯示狀態
End Sub
以上 麻煩老師幫我指正~學無止盡,養生平性~^.^ |
|
發表於 2011-6-3 21:50
| 
