Question

我对这个VBA的新东西可以有人帮助添加指定值的序列。 Output should be like this

这是我在这里得到一个对话的代码。

Sub sof20143262Serial_numbers()

    Dim i, iStep, j, jp1, startNumber, endNumber, delta
    Dim bEmpty As Boolean
    Dim strRange

    Application.ScreenUpdating = False

    bEmpty = False
    j = 2

    jp1: j + 1
    strRange : range name

    Do While (Not bEmpty)
        jp1 = j + 1
        strRange = "A" & j

        startNumber = Range(strRange).Value
        endNumber = Range("B" & j).Value
        bEmpty = IsEmpty(startNumber)

        If (bEmpty) Then
            Exit Do
        End If

        delta = endNumber - startNumber
        If (endNumber < startNumber) Then
            iStep = 1
            delta = -delta
        Else
            iStep = -1
        End If

        Range("C" & j).Value = startNumber
        endNumber = endNumber + iStep

        For i = endNumber To startNumber Step iStep
            Range(strRange).Offset(1).EntireRow.Insert shift:=xlDown
            Range("C" & jp1).Value = i - iStep
            Range("D" & jp1 & ":" & "E" & jp1).Value = Range("D" & j & ":" & "E" & j).Value
        Next
        '
        '   prepare the next loop:
        '
        j = j + delta + 1
        '
    Loop
    '
    Application.ScreenUpdating = True

End Sub

Answer 1

这张你最终结果的图片没有正确上传，你的代码在各方面都不能自我解释。但是，我试图将预期内容和修改后的代码修改为我认为完成后的样子。在这里。

Sub sof20143262Serial_numbers()

    Dim i As Long, iStep As Long
    Dim R As Long, jp1 As Long
    Dim startNumber As Long, endNumber As Long, delta As Long
    Dim bEmpty As Boolean
'    Dim strRange

    Application.ScreenUpdating = False

'    bEmpty = False
    R = 2
'    jp1: R + 1 strRange : range name

    With ActiveSheet
        Do While Len(.Cells(R, 1).Value)
    '        jp1 = R + 1
    '        strRange = "A" & R
        startNumber = Cells(R, 1).Value
'        startNumber = Range(strRange).Value
'        endNumber = Range("B" & R).Value
        endNumber = Cells(R, 2).Value

'        bEmpty = IsEmpty(startNumber)
'        If (bEmpty) Then
'            Exit Do
'        End If

        delta = Abs(endNumber - startNumber)
        iStep = IIf(endNumber < startNumber, 1, -1)
'        delta = endNumber - startNumber
'        If (endNumber < startNumber) Then
'            iStep = 1
'            delta = delta * -1
'        Else
'            iStep = -1
'        End If

        .Cells(R, 3).Value = startNumber
'        Range("C" & R).Value = startNumber
        endNumber = endNumber + iStep

        For i = endNumber To startNumber Step iStep
'            Range(strRange).Offset(1).EntireRow.Insert shift:=xlDown
            .Rows(R).EntireRow.Insert Shift:=xlUp
            R = R + 1
            .Cells(R, "C").Value = i - iStep
            .Cells(R, "D").Value = .Cells(R - 1, "D").Value
            .Cells(R, "E").Value = .Cells(R - 1, "E").Value
'            Range("C" & jp1).Value = i - iStep
'            Range("D" & jp1 & ":" & "E" & jp1).Value = Range("D" & R & ":" & "E" & R).Value
        Next
    End With

            ' prepare the next loop:
'            R = R + delta + 1
            R = R + 1
         Loop
     Application.ScreenUpdating = True
End Sub

我保留了大部分代码，以便您可以找到自己的方式。我的许多想法都以不同的方式实现。我希望你能理解这个意图，甚至更正我的代码，因为由于缺乏数据，整个事情从未尝试过。

如果您需要更多帮助，请与我联系。

Answer 2

我发现原始代码与我生成的代码之间存在很大差异。但是下面的代码会生成图片中的内容，只不过它会使用插入移动开始和结束编号。当然，这可以避免，但需要更多的编码。

Option Explicit

Enum Nws                            ' Rows & Columns
    NwsFirstDataRow = 2             ' = 1 caption row (adjust as required)
    NwsStart = 1                    ' 1 = column A (adjust as required)
    NwsEnd                          ' no value = previous + 1
    NwsSerial
End Enum

Sub SerialNumbers()
    ' 06 Apr 2017

    Dim Series As Long              ' = Start
    Dim Repeats As Integer          ' = End
    Dim R As Long                   ' row number
    Dim i As Integer                ' repeat counter

    R = NwsFirstDataRow
    With ActiveSheet
        Series = Val(.Cells(R, NwsStart).Value)
        Repeats = Val(.Cells(R, NwsEnd).Value)
        If Repeats Then
            Do While Series > 0
                For i = 1 To Repeats
                    If i > 1 Then
                        R = R + 1
                        .Rows(R).EntireRow.Insert Shift:=xlUp
                    End If
                    .Cells(R, NwsSerial).Value = Series * 10 + i
                Next i
                R = R + 1
                Series = Val(.Cells(R, NwsStart).Value)
            Loop
        End If
    End With
End Sub

Excel VBA：顺序数字+指定的开始将递增到结束值+向下移动列数据

2 个答案: