返回列表 上一主題 發帖

[發問] 接續記錄資料

kim223824

帖子
75 
主題
8 
精華
0 
積分
109 
點名
0  
作業系統
windows XP 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2015-4-19 
最後登錄
2023-5-2 
1# 跳轉到 »
發表於 2019-9-14 14:34 | 顯示全部帖子
回復 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

        靜思自在 : 看別人不順眼，是自己修養不夠。
返回列表 上一主題