返回列表 上一主題 發帖

[發問] 接續記錄資料

[發問] 接續記錄資料

本帖最後由 PJChen 於 2019-9-9 17:11 編輯

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

K欄接續記錄.rar (7.66 KB)

隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集5000篇 EXCEL函數

TOP

回復 2# hcm19522

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

TOP

回復 1# PJChen

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

    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

TOP

回復 4# kim223824

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

再次謝謝....

TOP

也可以這樣寫
  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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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


====================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

本帖最後由 准提部林 於 2019-9-16 13:48 編輯

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

=======================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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

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

TOP

回復 6# GBKEE

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

20190916.234903.jpg
昨天 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
複製代碼

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題