Question

我想创建一个将由重复“x”次的城市名称填充的列。

从另一张纸上取得的数据（Sheet1，A栏（文字），B（文字）和F（公式））：

伦敦问题3
Paris R 2

想要（Sheet2，A列（文本），B（文本）和C（数字））：

伦敦问题1
伦敦问题2
伦敦问题3
Paris R 1
Paris R 2

我知道这很容易，但我是VBA的新手：/ 我已经找到了类似下面的代码（来自描述它应该做我想要的），但是 - 这个循环永远不会结束，xls粉碎所以我无法看到它是否正在做我想要的东西。

    Sub RunMe()
Dim CopyX, x As Integer
CopyX = Sheets("Sheet2").Range("F1")
Sheets("Sheet1").Select
Range("A1").Copy

Do
    x = x + 1
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Loop Until x = CopyX
Application.CutCopyMode = False
End Sub

Answer 1

此代码 - 遍历sheet1中的每个项目 - 重复城市名称，但是在col F中指定了很多次 - 在第一个条目旁放置1 - 以1为步长在连续单元格中完成系列，直到达到col F值。

您可能需要调整工作表名称。

Sub x()

Dim r As Long, ws2 As Worksheet

Set ws2 = Sheets("Sheet2")

With Sheets("Sheet1")
    For r = 1 To .Range("A" & Rows.Count).End(xlUp).Row
        ws2.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 6).Value).Value = .Cells(r, 1).Resize(, 2).Value
        ws2.Range("B" & Rows.Count).End(xlUp)(2).Value = 1
        ws2.Range("B" & Rows.Count).End(xlUp).DataSeries Step:=1, Rowcol:=xlColumns, Type:=xlLinear, Stop:=.Cells(r, 6).Value
    Next r
End With

End Sub

Answer 2

插入if语句后一切都很顺利，因为在数据列F中也出现“0”值。还添加了清除和排序。也许有人会使用它，所以我实现了整个代码：）

Sub x()

Dim r As Long, ws2 As Worksheet
With Sheets("Sample_size")
Range(.Range("A2"), .Range("D2").End(xlDown)).ClearContents
End With

Set ws2 = Sheets("Sample_size")

With Sheets("Pres")
    For r = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Cells(r, 5).Value > 0 Then
        ws2.Range("B" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 5).Value).Value = .Cells(r, 1).Resize(, 2).Value
        ws2.Range("C" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 5).Value).Value = .Cells(r, 2).Resize(, 2).Value
        ws2.Range("d" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 5).Value).Value = .Cells(r, 5).Resize(, 2).Value
        ws2.Range("A" & Rows.Count).End(xlUp)(2).Value = 1
        ws2.Range("A" & Rows.Count).End(xlUp).DataSeries Step:=1, Rowcol:=xlColumns, Type:=xlLinear, Stop:=.Cells(r, 5).Value

        End If
    Next r
End With

ws2.Range("A2:D2").End(xlDown).Sort _
Key1:=Range("D2"), Order1:=xlDescending, _
key2:=Range("c2"), order2:=xlAscending, _
key3:=Range("b2"), order3:=xlAscending


End Sub

VBA基于变量创建列表 - 插入预定义时间的不同值

2 个答案: