iT邦幫忙

0

想把EXCEL 各欄逗號前的項目以10個為單位合在一起 VBA該如何寫好? 附圖

  • 分享至 

  • xImage

https://ithelp.ithome.com.tw/upload/images/20210429/20137089gjsbwY1aY7.pnghttps://ithelp.ithome.com.tw/upload/images/20210429/201370893NZ9F3htT9.pnghttps://ithelp.ithome.com.tw/upload/images/20210429/20137089DheZWIKQ7U.png

上圖1->2->3是手動完成的過程 第三張是想要的模式 有辦法用VBA寫出來嗎?

可以不用VBA解答嗎?

個人真的不喜歡VBA..
也可以啊 我以為只能用VBA才可以辦到
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

1
海綿寶寶
iT邦大神 1 級 ‧ 2021-04-30 15:04:05
最佳解答

1.在 Sheet1 準備好資料
2.執行 MainLoop
3.結果放在 Sheet2

Sub MainLoop()
    bFirst = True
    R = 2
    
    savedItem = ""
    savedQuantity = ""
    savedReference = ""
    savedPart = ""
    savedFootprint = ""
    
    Do While Sheets("Sheet1").Cells(R, 3) <> ""
                
        If bFirst = True Then
            savedItem = Sheets("Sheet1").Cells(R, 1)
            savedQuantity = Sheets("Sheet1").Cells(R, 2)
            savedReference = Sheets("Sheet1").Cells(R, 3)
            savedPart = Sheets("Sheet1").Cells(R, 4)
            savedFootprint = Sheets("Sheet1").Cells(R, 5)
            
            bFirst = False
        Else
            If Sheets("Sheet1").Cells(R, 1) = "" And Sheets("Sheet1").Cells(R, 2) = "" Then
                savedReference = savedReference & Sheets("Sheet1").Cells(R, 3)
            Else
                Call AddRowSheet2(savedItem, savedQuantity, savedReference, savedPart, savedFootprint)
                
                savedItem = Sheets("Sheet1").Cells(R, 1)
                savedQuantity = Sheets("Sheet1").Cells(R, 2)
                savedReference = Sheets("Sheet1").Cells(R, 3)
                savedPart = Sheets("Sheet1").Cells(R, 4)
                savedFootprint = Sheets("Sheet1").Cells(R, 5)
            End If
        End If
                
        R = R + 1
    Loop
    
    Call AddRowSheet2(savedItem, savedQuantity, savedReference, savedPart, savedFootprint)
End Sub
Sub AddRowSheet2(ByVal pItem, ByVal pQuantity, ByVal pReference, ByVal pPart, ByVal pFootprint)
    
    arrRef = Split(pReference, ",")
    
    For nI = 0 To UBound(arrRef) Step 10
        sRef = ""
        For nJ = nI To WorksheetFunction.Min(nI + 9, UBound(arrRef))
            sRef = sRef & arrRef(nJ) & IIf(nJ = UBound(arrRef), "", ",")
        Next nJ
        
        R = Range("Sheet2!C65536").End(xlUp).Row + 1
        
        If nI = 0 Then
            Sheets("Sheet2").Cells(R, 1) = pItem
            Sheets("Sheet2").Cells(R, 2) = pQuantity
            Sheets("Sheet2").Cells(R, 4) = pPart
            Sheets("Sheet2").Cells(R, 5) = pFootprint
        End If
        Sheets("Sheet2").Cells(R, 3) = sRef
    Next nI
    
End Sub

太神拉~~~ 感謝大神 阿Reference後面還有2個 我照片沒拍出來 !https://ithelp.ithome.com.tw/upload/images/20210503/20137089C0na88Lu9a.png

剛試著自己添加看看 卡住了一直報錯 如果您還有看到此回應的話 請教教我

修改程式了,如果你還有看到此回應的話

我要發表回答

立即登入回答