我有类似的任务: 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步。
我怎么能实现这个目标?
答案 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
屏幕截图(运行后):
这里的逻辑是从第一列获取每个名称,将其存储为字典键,然后获取旁边的值并将其存储为键值。然后我们在每个字典的键内部迭代,我们使用键值作为迭代的上限。在每次迭代期间,我们修改字符串以将其编号更改为迭代的“当前数字”。
我们选择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