Question

我一直在谷歌上搜索很多东西，我无法以任何方式使它工作。

我有一个包含很多名称的三列（名称，值1，值2）的表。我需要一个vba列出值1＆2之间的所有数字，包括它们及其各自的名称。

例如，对于A行3000、3003，使A行3000； A，3001； A，3002； A，3003，然后继续使用下一个名称，并将该名称的范围分成单个数字。

这有可能吗？

非常感谢。

Answer 1

我写了一个基于数组的数组，以收集然后传输值。

Sub expandValues()
    Dim i As Long, j As Long, arr As Variant

    With Worksheets("sheet5")
        .Cells(1, "E").Resize(1, 2) = Array("Name", "Value")

        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            ReDim arr(.Cells(i, "B").Value2 To .Cells(i, "C").Value2, 1 To 2)
            For j = LBound(arr, 1) To UBound(arr, 1)
                arr(j, 1) = .Cells(i, "A").Value2
                arr(j, 2) = j
            Next j
            .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0). _
              Resize(UBound(arr, 1) - LBound(arr, 1) + 1, UBound(arr, 2)) = arr
        Next i
    End With

End Sub

Addendum:

这是您的一个外部循环来处理各行。

Sub FillIN()
    Dim stri As Long, endi As Long
    Dim nm As string, i as long, j as long

    with workSheets(1)
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            nm = .Cells(i, "A").Value
            strti = .Cells(i, "B").Value
            endi = .Cells(i, "C").Value

            For j= strti To endi
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = nm
                .Cells(.Rows.Count, "E").End(xlUp).Offset(0, 1) = j
            Next j
        next i
    end with

End Sub

Answer 2

类似以下内容？

Option Explicit
Public Sub ListLines()
    Dim ws As Worksheet, i As Long, y As Long, rowCounter As Long
    Application.ScreenUpdating = False
    Set ws = ActiveSheet: rowCounter = 1
    With ws
        For i = 2 To GetLastRow(ws, 1)
            For y = .Cells(i, 2) To .Cells(i, 3)
                .Cells(rowCounter, 5) = .Cells(i, 1)
                .Cells(rowCounter, 6) = y
                 rowCounter = rowCounter + 1
            Next y
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, ByVal columNum As Long) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
End Function

Answer 3

这是我到目前为止所拥有的。它半有效。我需要使它跳到下一行（它会永远重复第一个），并在完成后使其停止。在第一个行范围完成后，我无法使其在starti和endi中的（行，列）的行部分和名称i上加上+1。我的也无限期地运行，所以一旦完成我也想念一下。

Sub FillIN()

Dim ws As Worksheet
Dim stri As Long, endi As Long
Dim Name As Variant

Set ws = Sheets(1)
Name = Sheets(1).Cells(2, 1).Value
strti = Sheets(1).Cells(2, 2).Value
endi = Sheets(1).Cells(2, 3).Value

For i = strti To endi
ws.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Value = i
ws.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Name
Next i

End Sub

在两个值之间列出名称和数字

3 个答案: