返回列表 上一主題 發帖

[發問] 關於跳行的問題

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-1-19 18:56 | 只看該作者

[發問] 關於跳行的問題

請問以下這組程式碼
為何我修改之後一直寫在同一行，不會往下一行寫入了

使用方法是: 開啟"匯出"Excel  -> 裡面點選按鈕"匯出"
就會執行裡面的VBA了
VBA會去找叫Rawdata的資料夾->裡面的EXCEL分別打開->取裡面我要的欄位資料 ->一直到最後一個EXCEL
  1. Sub TT()
  2. Dim Mypa$, workName$, brr(1), rr, br
  3. Const sWm As String = "\Rawdata\"
  4. t = Timer
  5. Mypa = ThisWorkbook.Path & sWm
  6. workName = Dir(Mypa & "*.xls")
  7. Sheet1.UsedRange.Offset(1).ClearContents
  8. Application.ScreenUpdating = False
  9. Do Until workName = ""
  10.     With GetObject(Mypa & workName)
  11.         n = n + 1
  12.         With .Sheets("Data")
  13.             brr(0) = .Range("a8").Resize(1, 21)
  14.             brr(1) = .Range("b19").Resize(1, 20)
  15.         End With
  16.         .Close False
  17.     End With
  18.     rr = brr(0): br = brr(1)
  19.     With Sheet1
  20.          i = .Cells(Rows.Count, 1).End(3).Row + 1
  21.         .Range("c" & i).Resize(1, 21) = rr
  22.         .Range("x" & i).Resize(1, 20) = br
  23.     End With
  24.     Erase brr()
  25.     workName = Dir
  26. Loop
  27. Application.ScreenUpdating = True
  28. MsgBox "共花" & Format(Timer - t, "0.000") & "秒" _
  29.     & Chr(10) & "找到 " & n & "筆資料", vbOKCancel + vbInformation
  30. End Sub
複製代碼
應該要這樣呈現

而不是一直在同一行呈現...(當然最後只有最後找到的一筆的結果)


我寫入的地方在這裡
  1. With Sheet1
  2.          i = .Cells(Rows.Count, 1).End(3).Row + 1
  3.         .Range("c" & i).Resize(1, 21) = rr
  4.         .Range("x" & i).Resize(1, 20) = br
  5.     End With
複製代碼
TEST.rar (155.66 KB)
收藏 分享

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2017-1-19 20:24 | 只看該作者
回復 1# starbox520
  1. Option Explicit

  3. Sub TT()
  4.     Dim Mypa$, workName$, brr(1), pos As Long
  5.     Dim t As Date, n As Long
  6.    
  7.     Const sWm As String = "\Rawdata\"
  8.     t = Timer
  9.     n = 0
  10.     Mypa = ThisWorkbook.Path & sWm
  11.     workName = Dir(Mypa & "*.xls")
  12.     Sheet1.UsedRange.Offset(1).ClearContents
  13.    
  14.     Application.ScreenUpdating = False
  15.     Do Until workName = ""
  16.         'With GetObject(Mypa & workName)
  17.         With Workbooks.Open(Mypa & workName)
  18.             n = n + 1
  19.             With .Sheets("Data")
  20.                 brr(0) = .Range("a8").Resize(1, 21)
  21.                 brr(1) = .Range("b19").Resize(1, 20)
  22.             End With
  23.             .Close False
  24.         End With
  25.         
  26.         With Sheet1
  27.             pos = .Cells(Rows.Count, 3).End(3).Row + 1
  28.             .Range("c" & pos).Resize(1, 21) = brr(0)
  29.             .Range("x" & pos).Resize(1, 20) = brr(1)
  30.         End With
  31.         Erase brr()
  32.         workName = Dir
  33.     Loop
  34.     Application.ScreenUpdating = True
  35.     MsgBox "共花" & Format(Timer - t, "0.000") & "秒" _
  36.             & Chr(10) & "找到 " & n & "筆資料", vbOKCancel + vbInformation
  37. End Sub
複製代碼

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2017-1-19 21:46 | 只看該作者
回復 2# c_c_lai


    謝謝C大分析
   
    懂了XD

TOP

        靜思自在 : 世上有兩件事不能等：一、孝順 二、行善。
返回列表 上一主題