Excel复制单元格值X次，最后数字增加答案

【问题标题】：Excel copy cell values X times with increasing numbers in the endExcel复制单元格值X次，最后数字增加
【发布时间】：2014-02-24 07:30:30
【问题描述】：

我有一个类似的任务： Copy value N times in Excel

但我的有点复杂。

所以，我有这种表：

    A         B
  dog-1.txt   3
  cat-1.txt   2
  rat-1.txt   4
  cow-1.txt   1

最终结果需要如下：

    A
  dog-1.txt
  dog-2.txt
  dog-3.txt
  cat-1.txt
  cat-2.txt
  rat-1.txt
  rat-2.txt
  rat-3.txt
  rat-4.txt
  cow-1.txt

如您所见，它不仅将单元格内容乘以从 B 列获取的 X 倍，而且还会将文件名中的数字增加 1 次。

我怎样才能做到这一点？

【问题讨论】：

标签： excel vba

【解决方案1】：

尝试以下方法（久经考验）：

Sub Extend()

    Dim Rng As Range, Cell As Range
    Dim WS As Worksheet, NewCell As Range
    Dim Dict As Object, NewStr As String

    Set WS = ThisWorkbook.Sheets("Sheet1") 'Modify as necessary.
    Set Rng = WS.Range("A1:A5") 'Modify as necessary.
    Set Dict = CreateObject("Scripting.Dictionary")

    For Each Cell In Rng
        If Not Dict.Exists(Cell.Value) Then
            Dict.Add Cell.Value, Cell.Offset(0, 1).Value
        End If
    Next Cell

    Set NewCell = WS.Range("C1") 'Modify as necessary.
    For Each Key In Dict
        For Iter = 1 To CLng(Dict(Key))
            NewStr = "-" & Iter & ".txt"
            NewStr = Mid(Key, 1, InStrRev(Key, "-") - 1) & NewStr
            NewCell.Value = NewStr
            Set NewCell = NewCell.Offset(1, 0)
        Next Iter
    Next Key

End Sub

截图（运行后）：

这里的逻辑是从第一列获取每个名称，将其存储为字典键，然后获取它旁边的值并将其存储为键值。然后我们在字典的每个键中进行迭代，我们使用键值作为迭代的上限。在每次迭代中，我们修改字符串以将其数字更改为迭代的“当前数字”。

我们选择C1 作为初始目标单元格。每次迭代，我们将其偏移一 (1) 行以适应新的/下一次迭代。

如果这有帮助，请告诉我们。

【讨论】：

【解决方案2】：

经过测试，这是你想要的:) 吗？（在我的系统中运行良好）

Sub teststs()
Dim erange As Range
Dim lrow As Integer
Dim cnt As Integer
Dim rnt As Integer
Dim str As String
Dim lrow2 As Integer


With ActiveSheet
lrow = .Range("A" & Rows.Count).End(xlUp).Row  ' finding the last row

For Each erange In .Range("A1:A" & lrow) ' loop though each each cell in the A column

cnt = erange.Offset(0, 1).Value
rnt = Mid(erange.Value, InStr(erange.Value, "-") + 1, 1)
For i = 1 To cnt 'Looping to cnt times

With Sheets("Sheet2")
lrow2 = .Range("A" & Rows.Count).End(xlUp).Row + 1

str = Replace(erange.Value, rnt, i, InStr(erange.Value, "-") + 1)
.Range("A" & lrow2).Value = Left(erange.Value, InStr(erange.Value, "-")) & str
End With
Next i

Next erange
End With
End Sub

【讨论】：

+1：用于更正Replace 上的错误。显然，Replace 比其他字符串操作技术更容易出错。