Excel 自動判斷缺少部分插入空白列

excel excel2016 excel vba

pesnlg 2019-07-12 19:21:24 ‧ 4705 瀏覽

分享至

範例(1~3為一循環)

(不好意思，發現圖有小錯誤，改成這張)

如圖所示，希望將左邊改成向右邊那樣，因為資料很多，無法一一插入
想請教如何將缺少部分插入空白列，或更進一步可以補上缺少的編號?
例: (1~2為一循環)
{1,2,1,,1,2,,2,1,} 改成 {1,2,1,2,1,2,1,2,1,2}

一列有好幾行資料，所以需要插入空白行 (希望可以做到通用更多，1~30為一循環之類的)
因為自己對這部分不了解，所以希望可以請教解決的方法

謝謝

來杯拿鐵 iT邦新手 2 級 ‧ 2019-07-13 00:16:46 檢舉

補上缺少編號，可以舉個例子嗎？
比方說{1,2, ,1,2,2}改成{1,2,3,1,2, ,2}

pesnlg iT邦新手 5 級 ‧ 2019-07-13 09:51:33 檢舉

不好意思
例: 設1~2為一循環 {1,,1,2,1,} 改成 {1,2,1,2,1,2}

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

2 個回答

來杯拿鐵

iT邦新手 2 級 ‧ 2019-07-13 15:09:50

最佳解答

目前基本測試沒問題，
極端測試還沒試過。
註解晚點補，先去吃飯。

Sub 資料清洗_插入下一列()

'宣告(自行調整)
    
    arrcir = Array(1, 2, 3) '循環資料(自行調整)
    Set firdata = Range("A2") '資料第一格(自行調整)
    
    lenarr = UBound(arrcir) + 1
    
'處理
    
    '初始化
    cir = 0
    dai = firdata.row
    endrow = firdata.End(xlDown).row
    
    '新增一列+編號
    Do
        cir = cir Mod lenarr
        
        If (Cells(dai, 1) <> arrcir(cir)) Then
            Rows(dai).Insert
            Cells(dai, 1) = arrcir(cir)
            endrow = endrow + 1
        End If
        
        dai = dai + 1
        cir = cir + 1
    Loop While dai <= endrow
    
End Sub

回應 6
分享
檢舉

看更多先前的回應...收起先前的回應...

pesnlg iT邦新手 5 級 ‧ 2019-07-13 17:31:41 檢舉

我稍微修改了一下程式碼

附上程式碼

Sub 資料清洗_插入下一列()

'宣告(自行調整)
    
    arrcir = Array(1, 2, 3) '循環資料(自行調整)
    Set firdata = Range("A2") '資料第一格(自行調整)
    
    lenarr = UBound(arrcir) + 1
    
    Dim lastnum, i As Integer '解決最後筆數不足的問題(lastnum為最後一列的編號，i作為跑迴圈使用)
    
'處理
    
    '初始化
    cir = 0
    dai = firdata.Row
    endrow = firdata.End(xlDown).Row
    
    lastnum = 0
    
    '新增一列+編號
    Do
        cir = cir Mod lenarr
        
        If (Cells(dai, 1) <> arrcir(cir)) Then
            Rows(dai).Insert
            Cells(dai, 1) = arrcir(cir)
            endrow = endrow + 1
        End If
        
        lastnum = Cells(dai, 1) '儲存最後一列的編號
        
        dai = dai + 1
        cir = cir + 1
    Loop While dai <= endrow
    
    If (lastnum < lenarr) Then '判斷是否為循環資料的最後 小於便插入後續編號
        For i = 1 To (lenarr - lastnum)
            Rows(dai).Insert
            Cells(dai, 1) = lastnum + 1
            lastnum = lastnum + 1
            dai = dai + 1
        Next i
    End If
End Sub

修改前

修改後

這樣應該就可以了吧?
非常謝謝您的協助

來杯拿鐵 iT邦新手 2 級 ‧ 2019-07-13 18:01:12 檢舉

肚子餓應該先去吃飯的，
沒考慮到最後一列不一定是"3"。

不客氣教學相長，
這樣下次我就會記得測試最後一列。

pesnlg iT邦新手 5 級 ‧ 2019-07-13 18:51:24 檢舉

感謝您花時間幫忙

來杯拿鐵 iT邦新手 2 級 ‧ 2019-07-14 12:41:30 檢舉

pesnlg你好
後來想到優化方法，
那就Do...loop再加一個條件，
判斷是否為循環資料最後一筆。

Loop While dai <= endrow

'改成下面這行

Loop Until ((dai > endrow And (cir = lenarr)) Or dai = 100)

為了避免反邏輯，
所以loop while改成loop until。
而dai = 100是安全機制
避免無窮迴圈，可修改掉。

pesnlg iT邦新手 5 級 ‧ 2019-07-15 00:24:10 檢舉

謝謝拿鐵大大
我又修改了一下陣列的部分(方便宣告)
後來發現dai = 100會使迴圈中斷所以把它拿掉了

Sub 資料清洗_插入下一列()

'宣告(自行調整)
    
    'arrcir = Array(1, 2, 3) '循環資料(自行調整)
    
    Dim arrcir(51) As Integer '先宣告需要多大的陣列 陣列大小為數值加1
    
    Set firdata = Range("A2") '資料第一格(自行調整)
    
    lenarr = UBound(arrcir) + 1 '陣列大小
    
'處理
    
    '初始化
    For i = 0 To UBound(arrcir) '例:大小為3 依序填入數字1~3
        arrcir(i) = i + 1
    Next i
    
    cir = 0
    dai = firdata.Row
    endrow = firdata.End(xlDown).Row
    
    '新增一列+編號
    Do
        cir = cir Mod lenarr
        
        If (Cells(dai, 1) <> arrcir(cir)) Then
            Rows(dai).Insert
            Cells(dai, 1) = arrcir(cir)
            endrow = endrow + 1
        End If
        
        dai = dai + 1
        cir = cir + 1
    Loop Until ((dai > endrow And (cir = lenarr)))
    
End Sub