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

我有一个类似的任务： 在Excel中复制N次

但我的情况有点复杂

所以，我有这样的表格：

AB 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步。

我怎么能做到这一点？

Answer 1

尝试以下（ 尝试和testing ）：

 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 

屏幕截图（运行后）：

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

我们selectC1作为初始目标小区。 每次迭代，我们将其偏移一（1）行以适应新的/下一个迭代。

让我们知道这是否有帮助。

Answer 2

经过testing，这是你想要的:)？ （在我的系统中工作正常）

 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