VBA 根据变量创建列表 - 插入不同的值预定义次数

Question

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

数据取自另一个 sheet（工作表 1，A 列（文本）、B 列（文本）和 F 列（公式））：

伦敦 Q 3
巴黎 R 2

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

伦敦 Q 1
伦敦 Q 2
伦敦 Q 3
巴黎 R 1
巴黎 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 值。

您可能需要调整 sheet 个名称。

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 根据变量创建列表 - 插入不同的值预定义次数

VBA Creating list based on variables - insert different values predefined times

excel

vba

copy-paste