[MACRO] Añadir Columna y relacionar 2 PºDigitos
Buenas todoexpertos,
Necesito crear una macro que para empezar cree una columna nueva a la derecha de la columna "Cod Postal" y la llame "Provincia", para posicionarse sobre "Cod Postal" se puede usar esta función:
Cells.Find(What:="Cod Postal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Una vez creada la columna hay que hacer la siguiente condición. Si los dos primeros dígitos de la columna "Cod Postal" son "01" me coloque "ALAVA" en la celda de la derecha que correspondería a la columna que acabamos de crear llamada "Provincia" y otra condición que nos colocase "02" como "ALBACETE". (Ejemplo)
Cod Postal Provincia
01255 ALAVA
02333 ALBACETE
01123 ALAVA
*** Necesito hacerla mediante una macro ya que tengo mas SUB dentro de ella.
Saludos y gracias por las molestias
Necesito crear una macro que para empezar cree una columna nueva a la derecha de la columna "Cod Postal" y la llame "Provincia", para posicionarse sobre "Cod Postal" se puede usar esta función:
Cells.Find(What:="Cod Postal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Una vez creada la columna hay que hacer la siguiente condición. Si los dos primeros dígitos de la columna "Cod Postal" son "01" me coloque "ALAVA" en la celda de la derecha que correspondería a la columna que acabamos de crear llamada "Provincia" y otra condición que nos colocase "02" como "ALBACETE". (Ejemplo)
Cod Postal Provincia
01255 ALAVA
02333 ALBACETE
01123 ALAVA
*** Necesito hacerla mediante una macro ya que tengo mas SUB dentro de ella.
Saludos y gracias por las molestias
1 respuesta
Respuesta de Enrique Bernal
1
Listo, esta macro hace lo que necesitas.
Sub Postal()
Cells.Find(What:="Cod Postal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
columna = ActiveCell.Column
Columns(columna + 1).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells("1", columna + 1).Value = "Provincia"
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Cells(Contador, columna) <> "" Then ' Si la condición es verdadera.
If Mid(Cells(Contador, columna).Value, 1, 2) = "01" Then
Cells(Contador, columna + 1).Value = "ALAVA"
Else
If Mid(Cells(Contador, columna).Value, 1, 2) = "02" Then
Cells(Contador, columna + 1).Value = "ALBACETE"
Else
Cells(Contador, columna + 1).Value = "CODIGO NO DEFINIDO"
End If
Sub Postal()
Cells.Find(What:="Cod Postal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
columna = ActiveCell.Column
Columns(columna + 1).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells("1", columna + 1).Value = "Provincia"
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Cells(Contador, columna) <> "" Then ' Si la condición es verdadera.
If Mid(Cells(Contador, columna).Value, 1, 2) = "01" Then
Cells(Contador, columna + 1).Value = "ALAVA"
Else
If Mid(Cells(Contador, columna).Value, 1, 2) = "02" Then
Cells(Contador, columna + 1).Value = "ALBACETE"
Else
Cells(Contador, columna + 1).Value = "CODIGO NO DEFINIDO"
End If
