DanBrother的部落格

Excel – 根據數值複製字串數量之巨集(VBA)實作

 1. 開啟Excel , 輸入字串和數量如下圖所示:

2. 左上角(Office按鈕  ) à (下方)Excel選項à常用à

(打勾) 在功能區顯示[開發人員]索引標籤(D)

點擊[開發人員] à 巨集安全性 à 巨集設定 à 啟用所有巨集 à 確定 

點擊[開發人員]索引標籤à插入à表單控制選項(按鈕) à拉出需要的按鈕長度à巨集名稱輸入Convertà新增

Sub Convert()
    Dim QuantityCellStart As String
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer  

    QuantityCellStart = "B4"  'Starting Position of the Cell Quantity
    Set rngQuantityCells = Range(QuantityCellStart, Range(QuantityCellStart).End(xlDown))    

    ' Copy Column Title to Sheet2
    Range(QuantityCellStart).Offset(-1, -1).Select
    Selection.Copy   
    With Sheets("Sheet2")
         .Range("A1").PasteSpecial xlPasteFormats
         .Range("A1").PasteSpecial xlPasteValues
    End With      

    For Each rngSinglecell In rngQuantityCells
        If IsNumeric(rngSinglecell.Value) Then
           If rngSinglecell.Value > 0 Then
              For intCount = 1 To rngSinglecell.Value
                 Range(rngSinglecell.Address).Offset(0, -1).Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
              Next
           End If
        End If
    Next
End Sub

3.按鈕1 可點滑鼠右鍵編輯文字修改成想要的文字, 如: 轉換字串 

另存新檔 à 輸入檔案名稱如test.xlsm, 存檔類型請選擇 Excel啟用巨集的活頁簿(*.xlsm) à確定  

重新打開此test.xlsm ,點擊 轉換字串 按鈕 ,如下圖所示:

 

在Sheet2 可以看到轉換後的結果: