[發問] 接續記錄資料

PJChen

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

hcm19522

https://blog.xuite.net/hcm19522/twblog/588250550

PJChen

回復 2# hcm19522

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

kim223824

回復 1# PJChen

K欄接續記錄.zip (103.25 KB)

下載次數: 7

2019-9-14 14:34

    Sub test_20190914()
    '確認 顯示結果 的最後一欄位置
    ROW1 = Sheets("顯示結果").Cells(Rows.Count, "A").End(3).Row
   
    '如果最後一欄 > 1表示有資料
    If ROW1 > 1 Then
        '將資料清除
        Sheets("顯示結果").Range("A2:A" & ROW1).Clear
    End If
   
    '判斷有幾列=========
    COL1 = Range("A1").End(xlToRight).Column
   
    '顯示結果 由第2列開始===================
    k = 2
   
    '列的迴圈==========
    For i = 1 To COL1
        
        '判斷每一欄的最後一個位置
        ROW2 = Cells(Rows.Count, i).End(3).Row
        '欄的迴圈==========
        For j = 1 To ROW2
            
            '判斷欄位內容 不是 "0" 的時候執行 內容
            If Cells(j, i) <> 0 Then
                '將欄位的值 給 顯示結果 的欄位
                Sheets("顯示結果").Cells(k, "A").Value = Cells(j, i).Value
                '往下加一欄
                k = k + 1
            End If
        
        Next
    Next

End Sub

PJChen

回復 4# kim223824

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

再次謝謝....

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

複製代碼

准提部林

Sub TEST01()
Dim Arr, Brr, r&, c%, N&
[K2:K20000].ClearContents
Arr = Intersect([A:G], ActiveSheet.UsedRange)
ReDim Brr(1 To UBound(Arr) * UBound(Arr, 2), 0)
For c = 1 To UBound(Arr, 2)
For r = 1 To UBound(Arr)
    If Arr(r, c) = 0 Or Arr(r, c) = "" Then Exit For
    N = N + 1: Brr(N, 0) = Arr(r, c)
Next r
Next c
If N > 0 Then [K2].Resize(N) = Brr
End Sub


====================

准提部林

Sub TEST02()
Dim xC As Range, xR As Range, N&
[K2:K20000].ClearContents
For Each xC In [A1].CurrentRegion.Columns
For Each xR In xC.Cells
    If xR = 0 Or xR = "" Then Exit For
    N = N + 1: [K2].Cells(N, 1) = xR
Next: Next
End Sub

=======================

PJChen

回復 6# GBKEE
回復 8# 准提部林

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

PJChen

回復 6# GBKEE

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

下載 (21.09 KB)

2019-9-16 23:54

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

複製代碼