返回列表 上一主題 發帖

[發問] 接續記錄資料

回復 10# PJChen
  1. With Sh.Range("aw1").CurrentRegion
  2.         Set Rng = Range(.Rows(2), .Rows(.Rows.Count))
  3.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

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

TOP

回復 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.   ** '目前區域是指以任意空白列及空白欄的組合為邊界的範圍

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

TOP

回復 13# GBKEE
Dear G大,
執行過程停在這裡,請問該如何改?
Rng.Cells(1, 5).Select

20190919.205801.jpg

TOP

回復 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

回復 15# GBKEE
感謝G大,

執行沒問題了^.^

TOP

回復 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

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題