Macro para desglosar por item en columnas

-------------------

Para Dante Amor

-----------------

Tu me proporcionaste este codigo

Dim condi1 As Date
Dim condi2 As Date

cond1 = TextBox1
cond2 = TextBox2
'Por Dante Amor
'DECLARACIÓN de variables
Dim a As Variant, b As Variant, c1 As Variant, c2 As Variant, c3 As Variant
Dim dic As Object, i As Long, j As Long, k As Long, sh As Worksheet
'ENTRADAS
Set sh = Sheets("Puestos")
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
a = Sheets("Salidas2").Range("A3:E" & Sheets("Salidas2").Range("A" & Rows.Count).End(3).Row).Value2
b = sh.Range("A3", sh.Range("A" & Rows.Count).End(3)).Value2
ReDim c1(1 To UBound(b), 1 To 4)
ReDim c2(1 To UBound(b), 1 To 4)
ReDim c3(1 To UBound(b), 1 To 4)
For i = 1 To UBound(b, 1)
dic(b(i, 1)) = i
Next
'PROCESO
For i = 1 To UBound(a, 1)
If a(i, 2) >= CDate(cond1) And a(i, 2) <= CDate(cond2) And dic.exists(a(i, 1)) Then
j = dic(a(i, 1))
Select Case k
Case 1 To 4: c1(j, k) = c1(j, k) + a(i, 5)
Case 5 To 8: c2(j, k - 4) = c2(j, k - 4) + a(i, 5)
Case 9 To 12: c3(j, k - 8) = c3(j, k - 8) + a(i, 5)
End Select
End If
Next
'SALIDA
sh.Range("C3").Resize(UBound(c1, 1), 4).Value = c1
sh.Range("J3").Resize(UBound(c2, 1), 4).Value = c2
sh.Range("Q3").Resize(UBound(c3, 1), 4).Value = c3

y necesito que me hagas unos cambios para que me desglose asi

utilizando las columnas B C D E  G H I J K L

en el codigo lo que pienso que me modifique  donde dice Month

k = Month(a(i, 2))

Porque ya no seria por mes

Lo que habria que agregar es que el codigo busque en la columna D de la hoja Salidas2 los mismos nombres de la fila 2 de la hoja Puestos que esta arriba

Esta es la hoja Salidas2 y en la columna D estan los nombres que deben substituir a los meses de la fila 2 de la hoja Puestos

1 Respuesta

Respuesta
1

No encuentro en dónde te proporcioné esa macro.

Pero, podría adaptarla o lo que necesitas. Pero podrías poner la macro original. Utiliza el icono par insertar código.


Explica con detalle qué necesitas.

Esto que pusiste: "k = Month(a(i, 2))", no lo veo en la macro.

En la imagen2, no veo ni las filas ni las columnas de excel. Podrías poner otra imagen. Lo que debe contener una imagen:


buen dia

esta es la macro original

Private Sub CommandButton6_Click()
Dim condi1 As Date
Dim condi2 As Date

cond1 = TextBox1
cond2 = TextBox2
'Por Dante Amor
'DECLARACIÓN de variables
Dim a As Variant, b As Variant, c1 As Variant, c2 As Variant, c3 As Variant
Dim dic As Object, i As Long, j As Long, k As Long, sh As Worksheet
'ENTRADAS
Set sh = Sheets("CT")
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
a = Sheets("Entradas2").Range("A3:E" & Sheets("Entradas2").Range("A" & Rows.Count).End(3).Row).Value2
b = sh.Range("A3", sh.Range("A" & Rows.Count).End(3)).Value2
ReDim c1(1 To UBound(b), 1 To 4)
ReDim c2(1 To UBound(b), 1 To 4)
ReDim c3(1 To UBound(b), 1 To 4)
For i = 1 To UBound(b, 1)
dic(b(i, 1)) = i
Next
'PROCESO
For i = 1 To UBound(a, 1)
If a(i, 2) >= CDate(cond1) And a(i, 2) <= CDate(cond2) And dic.exists(a(i, 1)) Then
j = dic(a(i, 1))
k = Month(a(i, 2))
Select Case k
Case 1 To 4: c1(j, k) = c1(j, k) + a(i, 5)
Case 5 To 8: c2(j, k - 4) = c2(j, k - 4) + a(i, 5)
Case 9 To 12: c3(j, k - 8) = c3(j, k - 8) + a(i, 5)
End Select
End If
Next
'SALIDA
sh.Range("C3").Resize(UBound(c1, 1), 4).Value = c1
sh.Range("J3").Resize(UBound(c2, 1), 4).Value = c2
sh.Range("Q3").Resize(UBound(c3, 1), 4).Value = c3

Range("A1").Select
End Sub

la parte que quiero que me modifiques es la linea que esta en negrita

k = Month(a(i, 2))

en vez de que busque por mes, que busque por puesto de salud (eso esta en la hoja Salidas2, columna D) y que lo ordene por esos puestos en la hoja Puestos

hay que cambiar Month y ese 2 que esta entre parentesis

el resultado debe aparecer en la hoja Puestos

como ves en la imagen deben aparecer los resultados en las columnas B C D E G H I J K L

solo en la F no.

Podrías poner la macro original. Utiliza el icono par insertar código.


La hoja Salidas2, columna D) y que lo ordene por esos puestos en la hoja Puestos

Puedes poner la imagen salidas2 completa, no veo las filas y las columnas.

Explica un ejemplo, qué tienes y qué quieres de resultado.

Private Sub CommandButton6_Click()
Dim condi1 As Date
Dim condi2 As Date
cond1 = TextBox1
cond2 = TextBox2
'Por Dante Amor
'DECLARACIÓN de variables
Dim a As Variant, b As Variant, c1 As Variant, c2 As Variant, c3 As Variant
Dim dic As Object, i As Long, j As Long, k As Long, sh As Worksheet
'ENTRADAS
Set sh = Sheets("Puestos")
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
a = Sheets("Salidas2").Range("A3:E" & Sheets("Salidas2").Range("A" & Rows.Count).End(3).Row).Value2
b = sh.Range("A3", sh.Range("A" & Rows.Count).End(3)).Value2
ReDim c1(1 To UBound(b), 1 To 4)
ReDim c2(1 To UBound(b), 1 To 4)
ReDim c3(1 To UBound(b), 1 To 4)
For i = 1 To UBound(b, 1)
dic(b(i, 1)) = i
Next
'PROCESO
For i = 1 To UBound(a, 1)
If a(i, 2) >= CDate(cond1) And a(i, 2) <= CDate(cond2) And dic.exists(a(i, 1)) Then
j = dic(a(i, 1))
k = Month(a(i, 2))
Select Case k
Case 1 To 4: c1(j, k) = c1(j, k) + a(i, 5)
Case 5 To 8: c2(j, k - 4) = c2(j, k - 4) + a(i, 5)
Case 9 To 12: c3(j, k - 8) = c3(j, k - 8) + a(i, 5)
End Select
End If
Next
'SALIDA
sh.Range("C3").Resize(UBound(c1, 1), 4).Value = c1
sh.Range("J3").Resize(UBound(c2, 1), 4).Value = c2
sh.Range("Q3").Resize(UBound(c3, 1), 4).Value = c3
Range("A1").Select
End Sub

salidas2

hoja receptora de datos: Puestos

los datos de la columna E de la hoja Salidas2 aparezcan en la hoja Puestos

desglosado por los items que aparecen en la fila 2 de la hoja Puestos, que son los mismos de la Columna D de la hoja Salidas 2.

por eso decia que habia que modificar esta linea del codigo que busca por mes de la columna B de la hoja Salidas2.

entonces los datos que va a buscar el codigo es el que esta en la columna E que son cantidades

por eso decia que habia que modificar esta linea del codigo

k = Month(a(i, 2))

donde esta el 2 debe ir 4 ques la columna D de la hoja Salidas2, pero ya no buscar por mes

sino por los items de la columna D

solo eso es lo que creo que hay que modificar, porque el resto del codigo hace lo demas que necesito

es Month el que hay que cabiar.


                    

Pero no estás explicando un ejemplo.

Solamente me estás diciendo qué cambiar en la macro.


Sigo sin entender qué necesitas. Para ti es muy claro porque conoces tus datos.

Como te comenté al inicio, "No encuentro en dónde te proporcioné esa macro."

Puedes poner el enlace donde te proporcioné esa macro para ver los ejemplos.


Además esa no parece ser la macro original.

Ya que esto que pusiste está incompleto:

Dim condi1 As Date
Dim condi2 As Date
cond1 = TextBox1
Cond2 = TextBox2

Declaras la variable condi1 pero abaja la utilizas como cond1 (te falta la letra i )


Pones esto, pero no explicas un ejemplo

Los datos de la columna E de la hoja Salidas2 ... son los mismos de la Columna D de la hoja Salidas 2.

Columna E o columna D?

Qué dato tienes en la columna E, puedes tomarlo y explicarme ese ejemplo.

¿Es decir en la columna E tienes el dato 300 en dónde lo quieres poner en la otra hoja y por qué?

A eso me refiero con explicar un ejemplo, debes tomar datos de tus imágenes y explicar qué tienes, en dónde lo quieres y por qué.

creo que ya lo explique

solo necesito que cambies esto

k = Month(a(i, 2))

el 2 tiene que ser 4 (que es la columna D de la hoja Salidas2)

que no busque fechas sino que texto (ejemplo. P/S Mojanales)

lo demas ya esta en el codigo

mejor no puedo explicarme

sino se puede pues gracias

Sí se puede, pero no entiendo qué necesitas.

Vamos por partes:

1. Pon aquí el enlace donde dices que yo te proporcioné el código.

2. La macro no busca el mes, si bien es cierto que toma el número de mes, no hace una búsqueda del mes, solamente posiciona el dato en una columna según el número de mes.

3. No es tan simple como tú dices: "cambiar el 2 por un 4".

4. Yo solamente te quiero ayudar, así que explica un ejemplo:

En la hoja "salida2", en la celda D28 tienes "laboratorio", en la E28 tienes "50" y en la A28 tienes "caja"

En la hoja "puestos" en la celda "C2" tienes "laboratorio".

Supongo que en la hoja "puestos" en la fila donde encuentre "caja", vamos a suponer que está en la fila 20, entonces en la celda C20 hay que pegar el valor "50".

_____________________________________

Lo anterior es una suposición, me gustaría que tú hicieras un ejemplo.

Ya vi porque la macro no está en tus preguntas. Está con otro usuario:

Macro para desglosar por cuatrimestre



Este es un ejemplo con datos, en ningún momento menciono líneas de la macro:

En la hoja "salida2", en la celda D28 tienes "laboratorio", en la E28 tienes "50" y en la A28 tienes "Fastener caja"

En la hoja "puestos" en la celda "C2" tienes "laboratorio".

Supongo que en la hoja "puestos" en la fila donde encuentre "Fastener caja", vamos a suponer que está en la fila 20, entonces en la celda C20 hay que pegar el valor "50".

_____________________________________

Lo anterior es una suposición, me gustaría que tú hicieras un ejemplo.

buen dia

creo que ya lo explique 

gracias

vere como le hago para resoverlo

Creo que ya lo explique

Me puedes decir en cuál de tus respuestas explicaste un ejemplo.

Solamente vienes aquí, pegas unas imágenes y un código y quieres que te resuelva tu petición.

Me dices en dónde debo cambiar la macro. Si ya sabes en dónde hacer los cambios en la macro, entonces simplemente haz los cambios y no menciones mi nombre.

¿Está macro fuer para otro usuario o quizás tienes 2 usuarios?

Traté de ayudarte realizando un ejemplo, solamente tenías que completarlo.

¡Gracias! 

disculpa, es un poco de frustracion por no explicarme bien

es exactamente como lo describiste antes

Este es un ejemplo con datos, en ningún momento menciono líneas de la macro:

En la hoja "salida2", en la celda D28 tienes "laboratorio", en la E28 tienes "50" y en la A28 tienes "Fastener caja"

En la hoja "puestos" en la celda "C2" tienes "laboratorio".

Supongo que en la hoja "puestos" en la fila donde encuentre "Fastener caja", vamos a suponer que está en la fila 20, entonces en la celda C20 hay que pegar el valor "50".

Espero se pueda todavía

Va la macro para cerrar la pregunta:

Private Sub CommandButton1_Click()
'Por Dante Amor
'DECLARACIÓN de variables
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim dic1 As Object, dic2 As Object
  Dim i As Long, j As Long, k As Long
  '
'ENTRADAS
  Set sh1 = Sheets("Salida2")
  Set sh2 = Sheets("Puestos")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  dic1.CompareMode = vbTextCompare
  dic2.CompareMode = vbTextCompare
  sh2.Range("B3", sh2.Cells(Rows.Count, Columns.Count)).ClearContents
  '
  a = sh1.Range("A3", sh1.Range("E" & Rows.Count).End(3)).Value2  'base Salida2
  b = sh2.Range("A3", sh2.Range("A" & Rows.Count).End(3)).Value2  'filas puestos
  c = sh2.Range("B2", sh2.Cells(2, Columns.Count).End(1)).Value2  'columnas puestos
  ReDim d(1 To UBound(b, 1), 1 To UBound(c, 2))                   'destino(filas, columnas)
  '
  For i = 1 To UBound(b, 1) 'filas puestos
    dic1(b(i, 1)) = i
  Next
  For i = 1 To UBound(c, 2) 'columnas puestos
    If c(1, i) <> "" Then dic2(c(1, i)) = i
  Next
  '
'PROCESOS
  For i = 1 To UBound(a, 1)
    If dic2.exists(a(i, 4)) And dic1.exists(a(i, 1)) Then
      If a(i, 2) >= CDate(TextBox1.Value) And a(i, 2) <= CDate(TextBox2.Value) Then
        j = dic1(a(i, 1))
        k = dic2(a(i, 4))
        d(j, k) = d(j, k) + a(i, 5)
      End If
    End If
  Next
  '
'SALIDAS
  sh2.Range("B3").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas