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)

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列?

Sub Ex()
Dim Rng As Range, M As Variant, c As Range, r As Range, W As Workbook, Sh As Worksheet
Set W = Workbooks("最新庫存.xlsx")
Set Sh = W.Sheets("廠缺表")
'------------------------------GBKEE
Set Rng = Sh.Range("aw2").CurrentRegion '來源區域從aw2~現行使用區塊
M = "廠缺Text"
For Each c In Rng.Columns 'Columns 範圍的Column集合物件
For Each r In c.Cells 'Cells 範圍的Cell集合物件
If r = "" Or r = 0 Then Exit For '遇空格or 0程式便跳下一欄,直到資料結束
M = M & "," & r
Next
Next
M = Split(M, ",")
With Sh.Range("bm1") '將讀取資料,顯示到BM欄
.CurrentRegion.Clear
.Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
End With
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)

Sub 廠缺Text()
Dim Rng As Range, M As Variant, c As Range, r As Range, W As Workbook, Sh As Worksheet
Set W = Workbooks("最新庫存.xlsx")
Set Sh = W.Sheets("廠缺表")
With Sh.Range("aw1").CurrentRegion
Set Rng = Range(.Rows(2), .Rows(.Rows.Count)) '來源區域不讀取第1列,設定從第2列開始讀取
M = "廠缺Text" '設定M為接收資料的變數,表頭為""內的文字,可任意更改
For Each c In Rng.Columns 'Columns 範圍的Column集合物件
For Each r In c.Cells 'Cells 範圍的Cell集合物件
[color=Red] If r = "" Or r = 0 Then Exit For[/color] '遇空格or 0程式便跳下一欄,直到資料結束
M = M & "," & r
Next
Next
M = Split(M, ",")
End With
With Sh.Range("bm1") '將讀取資料,顯示到BM欄
.CurrentRegion.Clear
.Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
End With
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!都略過不取(如同貼圖)
直到"空白",則代表整欄資料結束
本來想試著自行修改,但試了很久都改不出來,,請問我要如何修改程式?

Option Explicit
Sub EX()
Dim Rng As Range, M As Variant, c As Range, r As Range
Set Rng = Sheets("K欄讀取資料").Range("a1").CurrentRegion
M = "顯示結果"
For Each c In Rng.Columns 'Columns 範圍的Column集合物件
For Each r In c.Cells 'Cells 範圍的Cell集合物件
If r = "" Or r = 0 Then Exit For
M = M & "," & r
Next
Next
M = Split(M, ",")
With Sheets("顯示結果").Range("a1")
.CurrentRegion.Clear
.Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
End With
E

複製代碼

K欄接續記錄_延伸.rar (23.32 KB)

TOP