返回列表 上一主題 發帖

[發問] 接續記錄資料

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-9-9 17:10 | 顯示全部帖子

[發問] 接續記錄資料

本帖最後由 PJChen 於 2019-9-9 17:11 編輯

請教高手們：
我想在在K欄讀取A~G的資料
依序為A、B、C…欄位的順序
每個欄位的讀取為從上到下
數據長度不一定,有可能增加
讀取時，每一欄遇0或空格，自動讀取下一欄
但在K欄的顯示結果都要一直增加下去
也就是當資料欄數或列數增加時,K欄資料都要能讀取到並接續記錄
我想用VBA寫這種讀取方式，請問要怎麼寫這種

20190909.170733.jpg (138.31 KB)

20190909.170733.jpg

K欄接續記錄.rar (7.66 KB)

收藏 分享

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2019-9-10 22:26 | 顯示全部帖子
回復 2# hcm19522

感謝你的回覆,但我想學VBA語法
感覺在這裡發問，越來越得不到回應了....

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2019-9-14 20:29 | 顯示全部帖子
回復 4# kim223824

真感謝你,目前測試OK,我再好好研究一下,有問題的話再請教你。

再次謝謝....

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2019-9-16 23:17 | 顯示全部帖子
回復 6# GBKEE
回復 8# 准提部林

感謝二位大大熱情的提供程式，供我得以研究三種不同寫法，執行真的很快速，感謝+++
<(￣︶￣)>

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2019-9-16 23:55 | 顯示全部帖子
回復 6# GBKEE

請教G大：
資料中的表頭因為有帶公式,第一列的代號,我不想該它顯示在讀取的欄位(aw)中,請問要如何修改這句 Set Rng = Sh.Range("aw2").CurrentRegion,讓它不讀取第1列?

  1. Sub Ex()
  2. Dim Rng As Range, M As Variant, c As Range, r As Range, W As Workbook, Sh As Worksheet
  3.     Set W = Workbooks("最新庫存.xlsx")
  4.     Set Sh = W.Sheets("廠缺表")
  5. '------------------------------GBKEE
  6.     Set Rng = Sh.Range("aw2").CurrentRegion '來源區域 從aw2~現行使用區塊
  7.     M = "廠缺Text"
  8.     For Each c In Rng.Columns   'Columns 範圍的Column集合物件
  9.         For Each r In c.Cells   'Cells 範圍的Cell集合物件
  10.             If r = "" Or r = 0 Then Exit For   '遇空格or 0程式便跳下一欄,直到資料結束
  11.             M = M & "," & r
  12.         Next
  13.     Next
  14.     M = Split(M, ",")
  15.     With Sh.Range("bm1")  '將讀取資料,顯示到BM欄
  16.         .CurrentRegion.Clear
  17.         .Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
  18.     End With
  19. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2019-9-18 22:00 | 顯示全部帖子
回復 11# GBKEE
G大,
VBA是放在另一個程式中,執行時程式卡在紅色字那段,說是型態不符,請幫忙看下問題,感謝！ Text執行.rar (30.12 KB)
  1. Sub 廠缺Text()
  2. Dim Rng As Range, M As Variant, c As Range, r As Range, W As Workbook, Sh As Worksheet

  4.     Set W = Workbooks("最新庫存.xlsx")
  5.     Set Sh = W.Sheets("廠缺表")
  6.     With Sh.Range("aw1").CurrentRegion
  7.         Set Rng = Range(.Rows(2), .Rows(.Rows.Count))  '來源區域 不讀取第1列,設定從第2列開始讀取
  8.         M = "廠缺Text"   '設定M為接收資料的變數,表頭為""內的文字,可任意更改
  9.         For Each c In Rng.Columns   'Columns 範圍的Column集合物件
  10.             For Each r In c.Cells   'Cells 範圍的Cell集合物件
  11. [color=Red]                If r = "" Or r = 0 Then Exit For[/color]   '遇空格or 0程式便跳下一欄,直到資料結束
  12.                 M = M & "," & r
  13.             Next
  14.         Next
  15.         M = Split(M, ",")
  16.     End With
  17.         With Sh.Range("bm1")  '將讀取資料,顯示到BM欄
  18.             .CurrentRegion.Clear
  19.             .Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
  20.         End With
  21. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2019-9-19 21:00 | 顯示全部帖子
回復 13# GBKEE
Dear G大,
執行過程停在這裡,請問該如何改?
Rng.Cells(1, 5).Select

20190919.205801.jpg

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2019-9-20 21:33 | 顯示全部帖子
回復 15# GBKEE
感謝G大,

執行沒問題了^.^

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
9#
發表於 2019-10-5 19:35 | 顯示全部帖子
回復 6# GBKEE

請問G大,

我有另一表格需要類似這樣的轉貼,但不要貼成同一欄,而是依原資料的欄數去轉貼,但資料遇0或各種錯誤值 #N/A!、#VALUE!、#DIV/O!都略過不取(如同貼圖)
直到"空白",則代表整欄資料結束
本來想試著自行修改,但試了很久都改不出來,,請問我要如何修改程式?
  1. Option Explicit
  2. Sub EX()
  3.     Dim Rng As Range, M As Variant, c As Range, r As Range
  4.     Set Rng = Sheets("K欄讀取資料").Range("a1").CurrentRegion
  5.     M = "顯示結果"
  6.     For Each c In Rng.Columns   'Columns 範圍的Column集合物件
  7.         For Each r In c.Cells   'Cells 範圍的Cell集合物件
  8.             If r = "" Or r = 0 Then Exit For
  9.             M = M & "," & r
  10.         Next
  11.     Next
  12.     M = Split(M, ",")
  13.     With Sheets("顯示結果").Range("a1")
  14.         .CurrentRegion.Clear
  15.         .Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
  16.     End With
  17. E
複製代碼
  
K欄接續記錄_延伸.rar (23.32 KB)

TOP

        靜思自在 : 我們要做好社會的環保，也要做好內心的環保。
返回列表 上一主題