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

时间:2014-02-24 07:30:31

标签: excel excel-vba vba

我有类似的任务: 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步。

我怎么能实现这个目标?

2 个答案:

答案 0 :(得分:3)

尝试以下操作( 经过测试 ):

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

屏幕截图(运行后):

enter image description here

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

我们选择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