Secuencia o numerador único en vba?

Para Dante Amor

Respuesta de Dante Amor a la pregunta: Pregunta: Consolidar datos según el mes con vba?

Con respecto a esta respuesta ingeniero Dante Amor, me ha gustado mucho el código que le diste en esta respuesta y me he tomado mi tiempo para comprenderlo y buscar mas sobre el mismo sobre todo en el uso del objeto diccionario de vba, aunque no es mucho lo que se encuentra.

Me podrías ayudar con base en el mismo código a crear o a mantener la secuencia o numerador único de los ID con respecto al mes que corresponda, ya que al tomarlo tal cual me copia la secuencia última de la hoja 2 según la imagen de referencia de la misma pregunta.

Y como una imagen vale más que mil palabras

Su código

Sub ConsolidarPorMes()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic1 As Object, dic2 As Variant
  Dim llave As String
  Dim i As Long, j As Long, k As Long
  '
  a = Sheets("Hoja1").Range("A2", Sheets("Hoja1").Range("C" & Rows.Count).End(3)).Value
  b = Sheets("Hoja2").Range("A2", Sheets("Hoja2").Range("T" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(b, 1), 1 To UBound(b, 2))
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  '
  For i = 1 To UBound(a, 1)
    dic1(a(i, 2)) = a(i, 1) & "|" & a(i, 3)
  Next
  '
  For i = 1 To UBound(b, 1)
    llave = b(i, 2) & "|" & Month(b(i, 20))
    If Not dic2.exists(llave) Then
      j = j + 1
      dic2(llave) = j
    Else
      j = dic2(llave)
    End If
    For k = 1 To UBound(b, 2)
      Select Case k
        Case 1, 3 'SEC | NOMBRE
          If dic1.exists(b(i, 2)) Then
            c(j, 1) = Split(dic1(b(i, 2)), "|")(0)
            c(j, 3) = Split(dic1(b(i, 2)), "|")(1)
          Else
            c(j, k) = b(i, k)
          End If
        Case 2  'ID
          c(j, k) = b(i, k)
        Case 19 'OBS
          If b(i, k) <> "" Then c(j, k) = b(i, k)
        Case 20 'fecha
          'Último día del mes
          c(j, k) = DateSerial(Year(b(i, 20)), Month(b(i, 20)) + 1, 1) - 1
        Case Else 'VR
          c(j, k) = c(j, k) + b(i, k)
      End Select
    Next
  Next
  Sheets("Hoja3").Range("A2").Resize(dic2.Count, UBound(c, 2)).Value = c
End Sub

Espero su valiosa ayuda, soy novato pero me encanta aprender y he visto sus respuestas y son muy comprensibles y útilies para casos de la vida real.

1 Respuesta

Respuesta
3

Olvidemos el código por un momento.

Podrías explicar qué datos tienes, cuáles son las reglas y qué esperas de resultado.

Utiliza imágenes para tus explicaciones.

Buen día ingeniero Dante Amor

El ejemplo expuesto por el usuario original de la pregunta es similar, por eso tome la imagen que adjunto y le resalte la parte que me haría falta, en otras palabras tengo una nómina que sus periodos de pago pueden ser semanales, catorcenales, o quincenales, los empleados son los mismos del periodo, o sea que en la agrupación o consolidación mensual solo acumula las novedades por empleado.

El resultado esperado es que en la columna "A" genere una secuencia o numerador único de acuerdo al "ID" y a su fecha.

Pero no sé si esas imágenes son tus ejemplos o son los del otro usuario.

Y no puedo ir a la pregunta con el enlace que pusiste, me lleva a otra parte.

Podrías poner tu imagen de la hoja1 y la imagen con el resultado esperado.

Si tienes 2 fechas en el mismo mes, quieres agruparlas, cómo sería la agrupación.

Procura que las imágenes se vean completas con filas y columnas.

Hola ingeniero Dante, ya te coloco la imagen de la Hoja1 donde estarían los datos periodo a periodo y la Hoja 2 donde queda el resultado agrupado, y adjunto el código que funciona bien, solo faltaría que genere el numerador adecuado.  

Sub ConsolidarPorMes()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic1 As Object, dic2 As Variant
  Dim llave As String
  Dim i As Long, j As Long, k As Long
  '
  b = Sheets("Hoja1").Range("A2", Sheets("Hoja1").Range("T" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(b, 1), 1 To UBound(b, 2))
  Set dic2 = CreateObject("Scripting.Dictionary")
  '
  For i = 1 To UBound(b, 1)
    llave = b(i, 2) & "|" & Month(b(i, 20))
    If Not dic2.exists(llave) Then
      j = j + 1
      dic2(llave) = j
    Else
      j = dic2(llave)
    End If
    For k = 1 To UBound(b, 2)
      Select Case k
        Case 1, 3 'SEC | NOMBRE
          If dic2.exists(b(i, 2)) Then
            c(j, 1) = Split(dic2(b(i, 2)), "|")(0)
            c(j, 3) = Split(dic2(b(i, 2)), "|")(1)
          Else
            c(j, k) = b(i, k)
          End If
        Case 2  'ID
          c(j, k) = b(i, k)
        Case 19 'OBS
          If b(i, k) <> "" Then c(j, k) = b(i, k)
        Case 20 'fecha
          'Último día del mes
          c(j, k) = DateSerial(Year(b(i, 20)), Month(b(i, 20)) + 1, 1) - 1
        Case Else 'VR
          c(j, k) = c(j, k) + b(i, k)
      End Select
    Next
  Next
  Sheets("Hoja2").Range("A2").Resize(dic2.Count, UBound(c, 2)).Value = c
End Sub

Te anexo el código:

Sub ConsolidarPorMes()
  Dim b As Variant, c As Variant
  Dim dic2 As Variant
  Dim llave As String
  Dim i As Long, j As Long, k As Long
  '
  b = Sheets("Hoja1").Range("A2", Sheets("Hoja1").Range("T" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(b, 1), 1 To UBound(b, 2))
  Set dic2 = CreateObject("Scripting.Dictionary")
  '
  For i = 1 To UBound(b, 1)
    llave = b(i, 2) & "|" & Month(b(i, 20))
    If Not dic2.exists(llave) Then
      j = j + 1
      dic2(llave) = j
    Else
      j = dic2(llave)
    End If
    For k = 1 To UBound(b, 2)
      Select Case k
        Case 1    'Sec
          c(j, k) = j
        Case 2, 3 'ID, Nombre
          c(j, k) = b(i, k)
        Case 19 'OBS
          If b(i, k) <> "" Then c(j, k) = b(i, k)
        Case 20 'fecha 'Último día del mes
          c(j, k) = DateSerial(Year(b(i, 20)), Month(b(i, 20)) + 1, 1) - 1
        Case Else 'VR
          c(j, k) = c(j, k) + b(i, k)
      End Select
    Next
  Next
  Sheets("Hoja2").Range("A2").Resize(dic2.Count, UBound(c, 2)).Value = c
End Sub

Ingeniero buen día, probé el código pero no reinicia la numeración al cambiar el mes

Va con los cambios:

Sub ConsolidarPorMes()
  Dim b As Variant, c As Variant
  Dim dic1 As Object, dic2 As Object
  Dim llave As String
  Dim i As Long, j As Long, k As Long
  Dim mes As Date
  '
  b = Sheets("Hoja1").Range("A2", Sheets("Hoja1").Range("T" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(b, 1), 1 To UBound(b, 2))
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  '
  For i = 1 To UBound(b, 1)
    llave = b(i, 2) & "|" & Month(b(i, 20))
    If Not dic2.exists(llave) Then
      dic2(llave) = dic2.Count + 1
      mes = DateSerial(Year(b(i, 20)), Month(b(i, 20)) + 1, 1) - 1
      dic1(mes) = dic1(mes) + 1
    End If
    j = dic2(llave)
    '
    For k = 1 To UBound(b, 2)
      Select Case k
        Case 1    'Sec
          If c(j, k) = "" Then c(j, k) = dic1(mes)
        Case 2, 3 'ID, Nombre
          c(j, k) = b(i, k)
        Case 19 'OBS
          If b(i, k) <> "" Then c(j, k) = b(i, k)
        Case 20 'fecha 'Último día del mes
          c(j, k) = mes
        Case Else 'VR
          c(j, k) = c(j, k) + b(i, k)
      End Select
    Next
  Next
  Sheets("Hoja2").Range("A2").Resize(dic2.Count, UBound(c, 2)).Value = c
End Sub

[R ecuerda valorar las respuestas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas