Insertar columnas en los números faltantes horizontalmente en un rango
Necesito vuestra valiosa ayuda para que el siguiente macro inserte columnas en los números faltantes horizontalmente (en una fila) de un rango seleccionado.
Lo que sucede es que el siguiente macro no inserta las columnas cuando cuando hay otros rangos adyacentes en el lado izquierdo o derecho del rango seleccionado.
Sub InsertValueBetween3() 'TOV MEOD
'Link: https://www.extendoffice.com/documents/excel/1283-excel-insert-missing-numbers-in-sequence.html#a2
'How To Insert Numbers Or Rows For Missing Sequential Numbers In Excel?
'Updateby Extendoffice
Dim WorkRng As Range
Dim rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
Dim FirstCol As Integer
Dim LastCol As Integer
Dim FirstColLetter As String
Dim LastColLetter As String
'On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
'num1 = WorkRng.Range("A1").Value
FirstCol = Cells(6, 1).Column
FirstColLetter = Split(Cells(1, FirstCol).Address, "$")(1)
'MsgBox "FirstCol: " & FirstCol
'num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
'num2 = WorkRng.Range(1, Columns.Count).End(xlToLeft).Value
LastCol = Cells(6, Columns.Count).End(xlToLeft).Column
LastColLetter = Split(Cells(1, LastCol).Address, "$")(1)
MsgBox "LastCol: " & LastCol
MsgBox "FirstColLetter: " & FirstColLetter
MsgBox "LastColLetter: " & LastColLetter
num1 = FirstCol
num2 = LastCol - 1
MsgBox "num1: " & num1
MsgBox "num2: " & num2
interval = num2 - num1
MsgBox "interval: " & interval
ReDim outArr(1 To 2, 1 To interval + 1)
For Each rng In WorkRng
dic(rng.Value) = rng.Offset(1, 1).Value
Next
For i = 0 To interval
outArr(1, i + 1) = i + num1
If dic.Exists(i + num1) Then
outArr(2, i + 1) = dic(i + num1)
Else
outArr(2, i + 1) = ""
End If
Next
With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
.Value = outArr
'.Font.Color = RGB(255, 0, 0)
.Select
End With
End Sub
¿Qué estaré haciendo mal que no inserta las columnas?
Insertar columnas en los números faltantes horizontalmente en un rango