iT邦幫忙

0

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

範例(1~3為一循環)
https://ithelp.ithome.com.tw/upload/images/20190713/20119012aAhkgHNk8k.jpg
(不好意思,發現圖有小錯誤,改成這張)

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

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

謝謝

補上缺少編號,可以舉個例子嗎?
比方說{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}

2 個回答

1
來杯拿鐵
iT邦新手 3 級 ‧ 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
看更多先前的回應...收起先前的回應...
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

修改前
https://ithelp.ithome.com.tw/upload/images/20190713/20119012Hiywie2sWL.jpg
修改後
https://ithelp.ithome.com.tw/upload/images/20190713/20119012BI8jQ4x7Bp.jpg

這樣應該就可以了吧?
非常謝謝您的協助/images/emoticon/emoticon41.gif

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

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

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

感謝您花時間幫忙/images/emoticon/emoticon41.gif

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 檢舉

謝謝拿鐵大大
我又修改了一下 陣列的部分(方便宣告)/images/emoticon/emoticon06.gif
後來發現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

pesnlg
沒跳通知今天才看到訊息
你的陣列宣告方法方便多了

1
ccenjor
iT邦新手 3 級 ‧ 2019-07-12 22:56:26

這是我用函數做的增加空白列方式,請參考。
https://ccenjor.pixnet.net/blog/post/227873291

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

謝謝您的協助

記得給最佳解答喔

pesnlg iT邦新手 5 級 ‧ 2019-07-13 12:59:58 檢舉

謝謝提醒 但我還在等看看有沒有其他方法/images/emoticon/emoticon06.gif

我要發表回答

立即登入回答