Board logo

標題: 請問做法 ?A檔案有10000筆資料，要輸出成5個新檔A1~A5，每個檔案2000筆資料 [打印本頁]
作者: storybear    時間: 2018-3-3 22:58     標題: 請問做法 ?A檔案有10000筆資料，要輸出成5個新檔A1~A5，每個檔案2000筆資料

目前的狀況是，5個檔案都建立了，可是只有第A1有2000筆資料，A2~A5都是空白的，請大師看一下那裏有問題?
  1. Private Sub rutenexport() '匯出上架檔 -露天

  3. Dim sb, db As Workbook

  5. 'wp = ActiveWorkbook.Path & "\" '指定存檔位置
  6. wp = ActiveWorkbook.Path & "\" & "ruten" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "-" & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) & "\" '指定存檔位置

  8. If Len(Dir(wp, vbDirectory)) = 0 Then
  9.    
  10.    MkDir wp
  11.    
  12. End If


  15. Set sb = Workbooks("上架資料轉換.xlsx")

  17. sb.Sheets("露天上架檔").Range("AE:XX").Delete

  19. 'sb.Sheets("露天上架檔").Range("A:A").Delete '刪除第1行編號

  21. '================每個檔案2000筆資料匯出A
  22. For i = 1 To 5

  24. db1 = "ruten_auction2014-" & i & ".xls"

  26. Set NewBook = Workbooks.Add

  28.     With NewBook
  29.         .Title = "All Sales"
  30.         
  31.         .Subject = "Sales"
  32.         
  33.         .SaveAs Filename:=wp & db1
  34.         
  35.     End With
  36.    
  37. Set db = Workbooks(db1)
  38.    
  39. pt = i * 2000

  41. MsgBox db.Name

  43. sb.Sheets("露天上架檔").Range(Cells(pt - 1999, 1), Cells(pt, 31)).Copy Workbooks(db1).Sheets("sheet1").Range(Cells(pt - 1999, 1), Cells(pt, 31))

  45. 'db.Close

  47. Next i

  49. MsgBox "露天上架檔已匯出"
  50. End Sub
複製代碼
作者: 空白的樂章    時間: 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欄位貼上複製的儲存格內容



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)