Pregunta

I have a start value in column "A" (02) And an end value in column "B" (06)

In column "C" I'd like to list the range of number sequentially using the start and end values in columns "A" and "B". However I'd also like to shift the cell data down to stop any data overlapping.

To go one step further, I don't know if this is possible, but it would help if the data from the original row could be duplicated in each of the new rows that have been created with the sequential values.

Edit:

This code creates the sequential number specifying ONE start and end value cell, and doesn't shift the cells down.. this is where I'm at so far.

Sub Serial_numbers()

startNumber = [A1].Value

endNumber = [B1].Value

For i = startNumber To endNumber

ActiveCell.Offset(i - startNumber, 0) = i

Next i

End Sub

Here's a pictured example of what I'm trying to do:

  1. Initial Data:

enter image description here

  1. Required Output:

enter image description here

¿Fue útil?

Solución

Do you want this?

Sub sof20143262Serial_numbers()
  Dim i, iStep, j, jp1, startNumber, endNumber, delta
  Dim bEmpty As Boolean
  Dim strRange

'
  Application.ScreenUpdating = False
'
' intialize empty row key and set the first data row number j:
'
  bEmpty = False
  j = 2
'
' we use temporary memory for CPU time gain:
'   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)
'
'   terminate the loop if empty row:
'
    If (bEmpty) Then
      Exit Do
    End If
'
'   get number of rows to add:
'
    delta = endNumber - startNumber
    If (endNumber < startNumber) Then
      iStep = 1
      delta = -delta
    Else
      iStep = -1
    End If
'
    Range("C" & j).Value = startNumber
    endNumber = endNumber + iStep
'
'   insert a row and copy the right side data columns D to E,
'   here you can add more columns by changing E to any other letter:
'
    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

Initial data: enter image description here =====>

Ending data: enter image description here

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top