請問做法 ?A檔案有10000筆資料，要輸出成5個新檔A1~A5，每個檔案2000筆資料
- 帖子
- 1
- 主題
- 1
- 精華
- 0
- 積分
- 2
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office2003
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2018-3-3
- 最後登錄
- 2018-3-10
 
|
請問做法 ?A檔案有10000筆資料，要輸出成5個新檔A1~A5，每個檔案2000筆資料
目前的狀況是，5個檔案都建立了，可是只有第A1有2000筆資料，A2~A5都是空白的，請大師看一下那裏有問題?- Private Sub rutenexport() '匯出上架檔 -露天
- Dim sb, db As Workbook
- 'wp = ActiveWorkbook.Path & "\" '指定存檔位置
- wp = ActiveWorkbook.Path & "\" & "ruten" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "-" & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) & "\" '指定存檔位置
- If Len(Dir(wp, vbDirectory)) = 0 Then
-
- MkDir wp
-
- End If
- Set sb = Workbooks("上架資料轉換.xlsx")
- sb.Sheets("露天上架檔").Range("AE:XX").Delete
- 'sb.Sheets("露天上架檔").Range("A:A").Delete '刪除第1行編號
- '================每個檔案2000筆資料匯出A
- For i = 1 To 5
- db1 = "ruten_auction2014-" & i & ".xls"
- Set NewBook = Workbooks.Add
- With NewBook
- .Title = "All Sales"
-
- .Subject = "Sales"
-
- .SaveAs Filename:=wp & db1
-
- End With
-
- Set db = Workbooks(db1)
-
- pt = i * 2000
- MsgBox db.Name
- sb.Sheets("露天上架檔").Range(Cells(pt - 1999, 1), Cells(pt, 31)).Copy Workbooks(db1).Sheets("sheet1").Range(Cells(pt - 1999, 1), Cells(pt, 31))
- 'db.Close
- Next i
- MsgBox "露天上架檔已匯出"
- End Sub
|
|
|
|
|
|
|
|
- 帖子
- 12
- 主題
- 2
- 精華
- 0
- 積分
- 58
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- 2016
- 閱讀權限
- 20
- 註冊時間
- 2017-6-13
- 最後登錄
- 2018-7-26
|
2#
發表於 2018-3-24 00:08
| 只看該作者
這兩句語法有點問題
sb.Sheets("露天上架檔").Range(Cells(pt - 1999, 1), Cells(pt, 31)).Copy
Workbooks(db1).Sheets("sheet1").Range(Cells(pt - 1999, 1), Cells(pt, 31))
你仔細再看一下檔案，應該A2~A5不是沒資料
而是A2的資料貼到2001~4000列
A3貼到4001~6000列以此列推了
第二句程式碼應該固定儲存格就好
可以改成
Workbooks(db1).Sheets("sheet1").Range("A1").select
activate.paste
意思就是在A1欄位貼上複製的儲存格內容 |
|
|
|
|
|
|
|
