Excel – 根據數值複製字串數量之巨集(VBA)實作－DanBrother的部落格

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

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

VBA-copy1

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