EXCELeINFO

Macro para obtener números de varias series numéricas en Excel

by · 24 June, 2013

Problemática: Tengo que generar una serie de filas en base a series numéricas. Puedo tener hasta 100 series numéricas, y cada una tiene un número inicial y un número final. Las series no son consecutivas.

Series

Series1

La tabla anterior muestra 3 series de números. El propósito de este artículo es mostrar una macro que nos permita generar todos los números que haya entre el inicio y final de cada serie, es decir, si tomamos la primera serie queremos el 100, 101, 102… hasta llegar al 200. Ý así con todas las series. Todas en una misma tabla y de un sólo paso.

El resultado

Series2

Código de la macro (al final puedes descargarte el archivo de ejemplo)

'---------------------------------------------------------------------------------------
' Module    : Módulo1
' Author    : MVP Sergio Alejandro Campos
' Date      : 23/06/2013
' Purpose   : Llenar conjunto de series
' Website   : http://blogs.itpro.es/exceleinfo
'---------------------------------------------------------------------------------------
'
Sub Llenar_series()
Application.ScreenUpdating = False
Range("A2").Select
'
'Se recorren todas las filas de las columnas donde están las series
For i = 2 To Application.WorksheetFunction.CountA(Range("E:E"))
    ActiveCell.Value = Range("E" & i).Value
'
    For j = 1 To 3
        ActiveCell.Offset(0, j).Value = Range("E" & i).Offset(0, j + 1).Value
    Next j
'
    'Se definen los valores para las columnas
    Reg = Range("E" & i).Offset(0, 2).Value
    Cia = Range("E" & i).Offset(0, 3).Value
    Ciudad = Range("E" & i).Offset(0, 4).Value
'
    'Se recorren las filas llenando las series
    Do Until ActiveCell.Value >= Range("F" & i).Value
        ActiveCell.Offset(1, 0).Activate
        ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
        ActiveCell.Offset(0, 1).Value = Reg
        ActiveCell.Offset(0, 2).Value = Cia
        ActiveCell.Offset(0, 3).Value = Ciudad
    Loop
    '
    ActiveCell.Offset(1, 0).Activate
Next i
'
Application.ScreenUpdating = True
Range("A1").Select
'
End Sub

:: Descarga el ejemplo EXCELeINFO – Llenar series.xlsm

Tags:

You may also like...