12
返回列表 上一主題 發帖

[發問] 接續記錄資料

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2019-9-18 09:48 | 只看該作者
回復 10# PJChen
  1. With Sh.Range("aw1").CurrentRegion
  2.         Set Rng = Range(.Rows(2), .Rows(.Rows.Count))
  3.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
12#
發表於 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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
13#
發表於 2019-9-19 13:04 | 只看該作者
回復 12# PJChen
  1. Option Explicit
  2. Sub 廠缺Text()
  3. Dim Rng As Range, M As Variant, W As Workbook, Sh As Worksheet, i As Integer
  4.     Set W = Workbooks("最新庫存.xlsx")
  5.     Set Sh = W.Sheets("廠缺表")
  6.   '** 你檔案的資料不適用 'Range.CurrentRegion 屬性 傳回 Range 物件，該物件代表目前的區域。
  7.   ** '目前區域是指以任意空白列及空白欄的組合為邊界的範圍

  9.     With Sh.Range("aw1").CurrentRegion
  10.         Set Rng = Range(.Rows(2), .Rows(.Rows.Count))  '來源區域 不讀取第1列,設定從第2列開始讀取
  11.         Rng.Cells(1, 5).Select
  12.         MsgBox "你檔案不適用 CurrentRegionRng" & vbLf & Rng.Address(, , , 1, 1) & vbLf & Selection.Address(0, 0) & "錯誤值 造成程錯誤"
  13.     End With
  14.     M = "廠缺Text"   '設定M為接收資料的變數,表頭為""內的文字,可任意更改
  15.     Set Rng = Sh.Range("aw2")
  16.     Do Until Rng.Text = "" Or Rng.Text = 0 Or IsError(Rng)
  17.         i = 1
  18.         Do While Rng(i).Text <> "" And Rng(i).Text <> 0 And Not IsError(Rng(i))
  19.             M = M & "," & Rng(i)   '第i個處存格
  20.             i = i + 1
  21.         Loop
  22.         Set Rng = Rng.Offset(, 1)  '**左移一欄
  23.     Loop
  24.     M = Split(M, ",")
  25.     With Sh.Range("bm:bm")  '將讀取資料,顯示到BM欄
  26.         .Clear
  27.         .Resize(UBound(M) + 1) = Application.WorksheetFunction.Transpose(M)
  28.     End With
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

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

20190919.205801.jpg

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2019-9-20 08:41 | 只看該作者
回復 14# PJChen
明白如何錯誤後這段程式碼刪除
  1. With Sh.Range("aw1").CurrentRegion
  2.               Set Rng = Range(.Rows(2), .Rows(.Rows.Count))  '來源區域 不讀取第1列,設定從第2列開始讀取
  3.                Rng.Cells(1, 5).Select    '********將視窗移到  [ 最新庫存.xlsx]   再執行程式試試看******
  4.                MsgBox "你檔案不適用 CurrentRegionRng" & vbLf & Rng.Address(, , , 1, 1) & vbLf & Selection.Address(0, 0) & "錯誤值 造成程錯誤"
  5.                End With
複製代碼
是要你
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
16#
發表於 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 

論壇榮譽勳章論壇贊助勳章
17#
發表於 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

        靜思自在 : 時時好心就是時時好日。
12
返回列表 上一主題