Correr una macro en más de una celda
Hola que tal... Disculpen espero que alguien me pueda ayudar... Tengo la siguiente macro:
Sub iniciales()
Dim nombre As String
Dim largo As Integer
Dim x As Integer
Dim y As String
Dim letra_sig As String
Dim iniciales As String
nombre = ActiveCell.Value
largo = Len(nombre)
iniciales = Left(nombre, 1)
For x = 1 To largo
y = Mid(nombre, x, 1)
If y = " " Then
inicial_sig = Mid(nombre, x + 1, 1)
iniciales = iniciales & inicial_sig
End If
Next
ActiveCell.Offset(0, 1).Value = iniciales
End Sub
Esta es para iniciales pero tengo que seleccionar la celda y el resultado me lo arroja en la siguiente una por una... Tengo más de 4000 entradas y seguirá creciendo mi base de datos... Alguien me puede ayudar para que esto se haga de forma automática.
Gracias de antemano.
Sub iniciales()
Dim nombre As String
Dim largo As Integer
Dim x As Integer
Dim y As String
Dim letra_sig As String
Dim iniciales As String
nombre = ActiveCell.Value
largo = Len(nombre)
iniciales = Left(nombre, 1)
For x = 1 To largo
y = Mid(nombre, x, 1)
If y = " " Then
inicial_sig = Mid(nombre, x + 1, 1)
iniciales = iniciales & inicial_sig
End If
Next
ActiveCell.Offset(0, 1).Value = iniciales
End Sub
Esta es para iniciales pero tengo que seleccionar la celda y el resultado me lo arroja en la siguiente una por una... Tengo más de 4000 entradas y seguirá creciendo mi base de datos... Alguien me puede ayudar para que esto se haga de forma automática.
Gracias de antemano.
1 respuesta
Respuesta de jerryeagle
1
Pues una de dos, o la conviertes en Función o haces un Bucle Repetitivo:
Pero cambie tu código por uno más corto :P
Como Función
Public Function Iniciales(ByVal Nombre As String) As String
Dim Nombres() As String, Res(6) As String
Nombres = Split(Nombre, " ")
For i = 0 To UBound(Nombres)
Res(i) = Left(Nombres(i), 1)
Next
For i = 0 To UBound(Nombres)
Iniciales = UCase(Iniciales & Res(i))
Next
End Function
Con un Bucle For Next
Sub Iniciales2(ByVal Rango As Range)
Dim C As Range
For Each C In Rango
Dim Nombres() As String, Res(6) As String
Nombres = Split(C.Value, " ")
For i = 0 To UBound(Nombres)
Res(i) = Left(Nombres(i), 1)
Next
For i = 0 To UBound(Nombres)
C.Offset(0, 2).Value = UCase(C.Offset(0, 2).Value & Res(i))
Next
Next
End Sub
Y lo "llamas" así:
Sub ObtieneIniciales()
Iniciales2 Range("A3:A5") 'Tienes que seleccionar las Celdas d donde quieres extraer las iniciales
End Sub
Pero cambie tu código por uno más corto :P
Como Función
Public Function Iniciales(ByVal Nombre As String) As String
Dim Nombres() As String, Res(6) As String
Nombres = Split(Nombre, " ")
For i = 0 To UBound(Nombres)
Res(i) = Left(Nombres(i), 1)
Next
For i = 0 To UBound(Nombres)
Iniciales = UCase(Iniciales & Res(i))
Next
End Function
Con un Bucle For Next
Sub Iniciales2(ByVal Rango As Range)
Dim C As Range
For Each C In Rango
Dim Nombres() As String, Res(6) As String
Nombres = Split(C.Value, " ")
For i = 0 To UBound(Nombres)
Res(i) = Left(Nombres(i), 1)
Next
For i = 0 To UBound(Nombres)
C.Offset(0, 2).Value = UCase(C.Offset(0, 2).Value & Res(i))
Next
Next
End Sub
Y lo "llamas" así:
Sub ObtieneIniciales()
Iniciales2 Range("A3:A5") 'Tienes que seleccionar las Celdas d donde quieres extraer las iniciales
End Sub
