4

Estoy trabajando en una macro que me copie los valores de celda disponible en las columnas J, K, M y N en la columnas F y G debajo del primer valor con celda dependiendo el caso, la macro que tengo es la que muestro a continuacion y la que ejecuto por medio un boton con nombre "VH"

Sub InsertarDato()
Dim Celda As Range
Dim UltimaFila As Long, x As Long
Dim Valores(1 To 4) As Integer
Let UltimaFila = Cells(Rows.Count, 10).End(xlUp).Row
Valores(1) = 0: Valores(2) = 1: Valores(3) = 3: Valores(4) = 4
For Each Celda In Range("J3:J" & UltimaFila)
    For x = 1 To 4
        If Celda.Offset(0, Valores(x)) <> "" Or Celda.Offset(0, Valores(x)) <> 0 Then
            If Valores(x) = 0 Or Valores(x) = 1 Then
                Celda.Offset(Valores(x) + 1, -4).Formula = "=" & Celda.Offset(0, Valores(x)).Address(0, 0)
            Else
                Celda.Offset(Valores(x) - 2, -3).Formula = "=" & Celda.Offset(0, Valores(x)).Address(0, 0)
            End If
        End If
    Next x
Next Celda
End Sub

La tabla antes de ejecutar la macro la muestro en esta imagen:

introducir la descripción de la imagen aquí

Pero cuando ejecuto la macro no me resulta como espero y me queda asi:

introducir la descripción de la imagen aquí

en lugar de asi que es lo que espero al ejecutar el codigo:

introducir la descripción de la imagen aquí

Que puedo hacer para que el codigo me funcione? ya que segun lo que he probado donde da error es en el caso 2, ya que copia los valores en celdas sin espacio disponible, he intentado agregar una condicion a la macro con if o elseif adicional pero no lo he logrado o mejor dicho no se como hacerlo,agradeceria su ayuda en esta situacion si es posible.

A continuacion describo los casos que debe cumplir la macro en las condicicones,

Caso 1: *Cuando las celdas de las columnas J y K tengan un registro, se deben copiar en la columna F en los espacios disponibles debajo de la celda con valor; por ejemplo si las celdas J3 y K3 tienen un valor numerico se debe copiar el valor de celda en las celdas F4 y F5 respectivamente. *Cuando las celdas de las columnas M y N tengan un registro, se deben copiar en la columna G en los espacios disponibles debajo de la celda con valor; por ejemplo si las celdas M3 y N3 tienen un valor numerico se debe copiar el valor de celda en las celdas G4 y G5 respectivamente.

Caso 2: *Cuando la celda de la columnas K tenga un registro, se deben copiar en la columna F en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas K6 tiene un valor numerico se debe copiar el valor de celda en la celda F7. *Cuando la celda de la columna N tengan un registro, se deben copiar en la columna G en el espacio disponible debajo de la celda con valor; por ejemplo si la celda N6 tiene un valor numerico se debe copiar el valor de celda en la celda G7.

Caso 3: *Cuando la celda de la columnas J tenga un registro, se deben copiar en la columna F en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas J8 tiene un valor numerico se debe copiar el valor de celda en la celda F9. *Cuando la celda de la columna M tengan un registro, se deben copiar en la columna G en el espacio disponible debajo de la celda con valor; por ejemplo si la celda M8 tiene un valor numerico se debe copiar el valor de celda en la celda G9.

Caso 4: Cuando las celdas de las columnas J, K, M, y N tengan valores iguals a "0" ó " ", la macro no debe copiar valores, debe omitir y seguir evalando los casos 1, 2 y 3.

IMPORTANTE: Siempre van a haber los espacios disponibles necesarios para copiar y pagar los valores de celda en todos los casos ya que esa es otra macro que ejecuto con anterioridad.

Tambien les comparto el drive del archivo que estoy trabajando https://drive.google.com/file/d/1L-c0zrLz4U5S6RNFjMl27RK0fXOSHZr-/view?usp=sharing

Les comparto la macro que estube trabajando con @gbianchi

Sub InsertarDatos()

Let UltimaFila = Cells(Rows.Count, 4).End(xlUp).Row
Dim i
i = 3
Do While (i < UltimaFila)
    ''caso 1
 If (Range("J" & i).Value <> "" And Range("K" & i).Value <> "") Then
    ''aca copiamos los valores segun corresponde, a las celdas que queremos
    Range("F" & (i + 1)).Value = "=" & Range("J" & i).Address
    Range("F" & (i + 2)).Value = "=" & Range("K" & i).Address
    Range("G" & (i + 1)).Value = "=" & Range("M" & i).Address
    Range("G" & (i + 2)).Value = "=" & Range("N" & i).Address
    '..si hay mas copias...
    ''y ahora, aumentamos i a la siguiente linea a procesar
    i = i + 3
    ''caso 2
  ElseIf (Range("K" & i).Value <> "") Then
   Range("F" & (i + 1)).Value = "=" & Range("K" & i).Address
   Range("G" & (i + 1)).Value = "=" & Range("N" & i).Address
    '.... hacemos las copias..
    ''aumentamos i
    i = i + 2
    ''caso 3
  ElseIf (Range("J" & i).Value <> "") Then
   Range("F" & (i + 1)).Value = "=" & Range("J" & i).Address
   Range("G" & (i + 1)).Value = "=" & Range("M" & i).Address
    '.... hacemos las copias...
    ''aumentamos i
   i = i + 2
  ''caso 4
  Else
  
 End If
 Loop

End Sub
8
  • 1
    Ahora, me gusta mas!!! y cual es la condicion que no anda???
    – gbianchi
    Commented el 3 sept. 2020 a las 15:48
  • 1
    @gbianchi Hooola! pues mira, segun lo que he probado las dos conficiones que tengo de If y else solo andan en los casos 1 , 3 y 4, el caso 2 es el problema y no se que hacer ya que esas condiciones no me funcionan cuando solo tengo que copiar valores de la columna K y N en las columnas F y G Commented el 3 sept. 2020 a las 15:55
  • 1
    Lo que seguis sin explicar (o yo no entiendo) es como es cada condicion.. o sea, como sabes que copiar y a donde? lo que te falta explicar es el caso...
    – gbianchi
    Commented el 3 sept. 2020 a las 16:45
  • 1
    Listo @gbianchi ya amplie la pregunta indicando los casos en que debo copiar y el destino de copiado, todo en relacion a las imagenes que comparti arriba. Commented el 3 sept. 2020 a las 17:21
  • 2
    ok... ahi entendi... no veo en todo tu codigo donde revisas las condiciones, y creo que ahi radica tu problema... a veces, mas codigo es mejor para estas cosas.... veo si puedo ponerte una respuesta...
    – gbianchi
    Commented el 3 sept. 2020 a las 17:46

3 respuestas 3

4

Tu problema fundamental es identificar cuando es caso 1, 2, 3 o 4. Pero afortunadamente, lo tienes identificado cada caso en la última columna.

La macro debería leer esa columna, y según sea caso 1, 2, 3 o 4, proceder de una manera u otra.

El inconveniente es que esas celdas están combinadas. Cuando las celdas están combinadas, solamente tiene valor la primera del conjunto, las otras en realidad están vacías. Así que hay que acceder al área combinada (MergeArea) y dentro de ese área, estudiar siempre la primera celda, que es la que tiene el valor (la primera celda de un rango siempre es Cells(1,1)

Sabiendo esto, he diseñado un código que hace cada caso individualmente. Si ve que un área combinada ya ha sido estudiada, la ignora y pasa a la siguiente fila.

He aquí su funcionamiento:

introducir la descripción de la imagen aquí

Y el código:

Sub test()
Application.ScreenUpdating = False
Dim i As Long
Dim UF As Long
Dim AreaEstudiada As String

UF = Range("A" & Rows.Count).End(xlUp).Row

For i = 3 To UF Step 1 'tus datos empiezan en fila 3 según ejemplo
    If AreaEstudiada = Range("P" & i).MergeArea.Address Then
        'este caso ya ha sido estudiado, no hago nada
    Else
        AreaEstudiada = Range("P" & i).MergeArea.Address
        Select Case UCase(Range("P" & i).MergeArea.Cells(1, 1).Value)
            Case "CASO 1"
            'se deben copiar en la columna F en los espacios disponibles debajo de la celda con valor;
            'por ejemplo si las celdas J3 y K3 tienen un valor numerico se debe copiar el valor de celda
            'en las celdas F4 y F5 respectivamente. *Cuando las celdas de las columnas M y N tengan un registro,
            'se deben copiar en la columna G en los espacios disponibles debajo de la celda con valor;
            'por ejemplo si las celdas M3 y N3 tienen un valor numerico se debe copiar el valor de celda en las celdas G4 y G5 respectivamente.
                Range("F" & i + 1).Value = Range("J" & i).Value
                Range("F" & i + 2).Value = Range("K" & i).Value
                Range("G" & i + 1).Value = Range("M" & i).Value
                Range("G" & i + 2).Value = Range("N" & i).Value
            Case "CASO 2"
            'Cuando la celda de la columnas K tenga un registro, se deben copiar en la columna F
            'en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas K6
            'tiene un valor numerico se debe copiar el valor de celda en la celda F7. *Cuando la celda
            'de la columna N tengan un registro, se deben copiar en la columna G en el espacio disponible
            'debajo de la celda con valor; por ejemplo si la celda N6 tiene un valor numerico se debe copiar el valor de celda en la celda G7.
                Range("F" & i + 1).Value = Range("K" & i).Value
                Range("G" & i + 1).Value = Range("N" & i).Value
            Case "CASO 3"
            'Cuando la celda de la columnas J tenga un registro, se deben copiar en la columna F en el
            'espacios disponible debajo de la celda con valor; por ejemplo si las celdas J8 tiene un
            'valor numerico se debe copiar el valor de celda en la celda F9. *Cuando la celda de la
            'columna M tengan un registro, se deben copiar en la columna G en el espacio disponible
            'debajo de la celda con valor; por ejemplo si la celda M8 tiene un valor numerico se debe copiar el valor de celda en la celda G9.
                Range("F" & i + 1).Value = Range("J" & i).Value
                Range("G" & i + 1).Value = Range("M" & i).Value
            Case "CASO 4"
                ' la macro no debe copiar valores, debe omitir
                'no hacemos nada
            Case Else
                MsgBox "ERROR, CASO NO CONTEMPLADO", vbCritical
                End
        End Select
    End If
Next i
Application.ScreenUpdating = True

End Sub

ACTUALIZACIÓN: Como la columna P no se puede utilizar, lo que hecho ha sido intentar establecer una relación matemática entre los ID y los casos.

Si te fijas, según tu ejemplo, los ID que se repiten 3 veces, son el caso 1. Los que se repiten 1 vez, son caso 4. Y los que se repiten 2 veces pueden ser caso 2 o 3, dependiendo de si las columnas J y M están vacías o no.

Sobre esa base matemática, he modificado el código original. Lo que hecho ha sido incorporar un diccionario.

Diccionarios en VBA

Con este objeto, puedo almacenar valores únicos y asignarles un valor. Es decir, voy apuntando cada uno de los ID de la columna C, y asignándoles si son Caso 1, 2, etc.

Luego es prácticamente el mismo bucle de antes. Este es el código:

Sub test()
Application.ScreenUpdating = False

Dim MiDict As Object
Set MiDict = CreateObject("Scripting.Dictionary")

Dim i As Long
Dim UF As Long

UF = Range("A" & Rows.Count).End(xlUp).Row

'primero, analizamos todos los ID de la columna C. Tenemos que asociar a cada ID uno de los 4 casos posibles.

For i = 3 To UF Step 1 'tus datos empiezan en fila 3 según ejemplo
    'primero comprobamos si ese ID existe en el diccionario
    
    If MiDict.Exists(Range("C" & i).Value) = False Then
        'no existe. Estudio que caso es y lo guardo en el diccionario
        If Application.WorksheetFunction.CountIf(Range("C" & 3 & ":C" & UF), Range("C" & i).Value) = 3 Then
            'si el ID existe 3 veces, es caso 1
            MiDict.Add Range("C" & i).Value, "CASO 1"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & 3 & ":C" & UF), Range("C" & i).Value) = 1 Then
            'si el ID existe 1 sola vez, entonces es caso 4.
            MiDict.Add Range("C" & i).Value, "CASO 4"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & 3 & ":C" & UF), Range("C" & i).Value) = 2 Then
            'existe 2 veces, pero tenemos que ver si es caso 2 o 3
            'es caso 2 si J y M están vacías
            If Range("J" & i).Value = "" And Range("M" & i).Value = "" Then
                MiDict.Add Range("C" & i).Value, "CASO 2"
            Else
                MiDict.Add Range("C" & i).Value, "CASO 3"
            End If
        Else
            'si existe una cantidad de veces diferente a 1, 2 o 3, es un caso diferente, no desarrollado.
            MsgBox "ERROR;CASO NO DETECTADO", vbCritical
            End
        End If
    End If
Next i

'ya tenemos los casos estudiados. ahora buscamos cada id en el diccionario. La primera vez haremos su proceso, y lo marcaremos como completado.
'la segunda vez que mire ese ID, como está marcado como completado, lo ignorará


For i = 3 To UF Step 1 'tus datos empiezan en fila 3 según ejemplo

    Select Case UCase(MiDict(Range("C" & i).Value))
        Case "CASO 1"
        'se deben copiar en la columna F en los espacios disponibles debajo de la celda con valor;
        'por ejemplo si las celdas J3 y K3 tienen un valor numerico se debe copiar el valor de celda
        'en las celdas F4 y F5 respectivamente. *Cuando las celdas de las columnas M y N tengan un registro,
        'se deben copiar en la columna G en los espacios disponibles debajo de la celda con valor;
        'por ejemplo si las celdas M3 y N3 tienen un valor numerico se debe copiar el valor de celda en las celdas G4 y G5 respectivamente.
            Range("F" & i + 1).Value = Range("J" & i).Value
            Range("F" & i + 2).Value = Range("K" & i).Value
            Range("G" & i + 1).Value = Range("M" & i).Value
            Range("G" & i + 2).Value = Range("N" & i).Value
        Case "CASO 2"
        'Cuando la celda de la columnas K tenga un registro, se deben copiar en la columna F
        'en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas K6
        'tiene un valor numerico se debe copiar el valor de celda en la celda F7. *Cuando la celda
        'de la columna N tengan un registro, se deben copiar en la columna G en el espacio disponible
        'debajo de la celda con valor; por ejemplo si la celda N6 tiene un valor numerico se debe copiar el valor de celda en la celda G7.
            Range("F" & i + 1).Value = Range("K" & i).Value
            Range("G" & i + 1).Value = Range("N" & i).Value
        Case "CASO 3"
        'Cuando la celda de la columnas J tenga un registro, se deben copiar en la columna F en el
        'espacios disponible debajo de la celda con valor; por ejemplo si las celdas J8 tiene un
        'valor numerico se debe copiar el valor de celda en la celda F9. *Cuando la celda de la
        'columna M tengan un registro, se deben copiar en la columna G en el espacio disponible
        'debajo de la celda con valor; por ejemplo si la celda M8 tiene un valor numerico se debe copiar el valor de celda en la celda G9.
            Range("F" & i + 1).Value = Range("J" & i).Value
            Range("G" & i + 1).Value = Range("M" & i).Value
        Case "CASO 4"
            ' la macro no debe copiar valores, debe omitir
            'no hacemos nada
        Case Else
            'significa que es un caso ya estudiado. No hacemos nada
    End Select
    
    MiDict(Range("C" & i).Value) = "CASO ESTUDIADO"
Next i

MiDict.RemoveAll
Set MiDict = Nothing

Application.ScreenUpdating = True

End Sub
3
  • 1
    Hoola! @ElierSánchezE-Infantes que gran aporte me acabas de dar, pero pues mira la columna P que es la que tiene los casos identificados como tu me indicas es solo una columna de apoyo que puse en el ejemplo para poderme explicar mejor. Commented el 4 sept. 2020 a las 1:40
  • 1
    @KarlaYinethRojasAlvernia Por favor, mira la actualización que he añadido al final de la respuesta
    – Esei
    Commented el 4 sept. 2020 a las 12:21
  • 2
    pues mira me sirvio en una tabla con mayor numero de datos, la macro esta super compleja, muchas gracias, me va a servir ademas para muchos otros procesos, esta genial y muy completa. Commented el 4 sept. 2020 a las 13:03
4

cambiemos totalmente la logica de tu proceso para entender claramente que hacer en cada caso...

primero,en lugar de iterar un rango, como hay filas que no son procesadas, vamos a hacer lo siguiente:

Let UltimaFila = Cells(Rows.Count, 10).End(xlUp).Row
dim i as int = 3
while (i < UltimaFila)
    ....
end while

Ahora, dentro del while, vamos a revisar cada una de las condiciones, en orden...

''caso 1
if range("J" & i).value <> "" and range("K" & i).value <> "" then
    ''aca copiamos los valores segun corresponde, a las celdas que queremos
    range("F" & (i+1)).value = range("J" & i).value
    range("F" & (i+2)).value = range("K" & i).value
    ..si hay mas copias...
    ''y ahora, aumentamos i a la siguiente linea a procesar
    i = i + 3
''caso 2
else if(range("K" & i).value <> "") then
    .... hacemos las copias...
    ''aumentamos i
    i = i +2
else
    ''caso 3
    
end if

Fijate que te escribi la logica que tenes que usar para cada caso... probalo, seguilo y cualquier cosa actualizamos la respuesta.

8
  • 1
    mira cuando introduzco el codigo que me compartes en la linea dim i as int = 3 me da error de compilacion: error de sintaxis lo mismo para End While, de resto comprendi las notas para seguir el proceso en cada caso, me parece un codigo muy completo en cuanto a la logica, muchas gracias Commented el 3 sept. 2020 a las 18:31
  • 2
    lo hice sin excel y de memoria.. puede que haya confundido la sintaxis con otro lenguaje @KarlaYinethRojasAlvernia
    – gbianchi
    Commented el 3 sept. 2020 a las 18:36
  • 2
    @KarlaYinethRojasAlvernia ultima fila te trae el valor de la ultima fila? lo chequeaste?
    – gbianchi
    Commented el 3 sept. 2020 a las 20:57
  • 2
    @KarlaYinethRojasAlvernia ahora que veo, esto Cells(Rows.Count, 10).End(xlUp).Row esta mal.. va a la fila 10 y despues selecciona todo hasta el principio... estoy en lo correcto??? vos tenes que fijarte todas las filas hasta abajo.. fijate de grabar una macro que lo haga, y copiate ese codigo ;)
    – gbianchi
    Commented el 3 sept. 2020 a las 21:02
  • 2
    Pero tu columna j tiene cosas vacias... a esta macro le falta mucho mas de lo que pensas. Deberias verificar la cantidad de filas usando xlDown y sobre la columna 1 o la que tenga datos en todas las filas
    – gbianchi
    Commented el 3 sept. 2020 a las 21:13
1

Intenta con

Let UltimaFila = Cells(Rows.Count, 10).End(xlUp).Row dim i i = 3 Do while (i < UltimaFila)

'Aca los casos condicionados que te da @gbianchi

Loop

1
  • 1
    Hola! @BriamRamonRodriguez, gracias por tu sugerencia, lo intente y en el proceso logre algo. Commented el 4 sept. 2020 a las 13:04

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.