GBKEE

也可以這樣寫

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. End Sub

複製代碼

GBKEE

回復 10# PJChen

1. With Sh.Range("aw1").CurrentRegion
   
2.         Set Rng = Range(.Rows(2), .Rows(.Rows.Count))
   
3.     End With

複製代碼

GBKEE

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

複製代碼

GBKEE

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

複製代碼

是要你