Ayuda con macro

LOD_Fredy · #1 (**permalink**) 20/12/2009, 14:42

Hola a todos, disculpen la molestia pero necesito su ayuda.

Necesito hacer una macro para una hoja de excel que me permita hacer lo siguiente:

Tengo mi archivo de excel (encuentas.xlsm) que contiene 1 hoja con 5 respuestas, las respuestas son tomadas de otro archivo (casos_cerrados.xls), en la hoja encuestas.xlsm, lo que hice es usar formulas para tomar el valor de las respuestas de casos_cerrados y pegarlos en las celdas correspondientes. Esto de las celdas correspondientes va mas que nada por que en encuetas.xlsm tengo las posibles respuestas de las 5 preguntas en las columnas C,E,G,I,K, cada columna dice Excelente, Muy bueno, Bueno, Regular, Deficiente.
en los renglones 15,20,25,30,35 tengo las 5 preguntas. Segun la respuesta a la pregunta es la columna donde escribo la formula de forma que si la respuesta es muy bueno en la primerpregnta, escribo la siguiente formula en la celda C15:

='[Casos_Cerrados.xls]ENE-FEB'!$B$3

Como pueden notar, tengo una hoja llamada ENE-FEB, tengo 6 hojas para cada bimestre pero ya con poder hacer esto para una hoja, puedo hacerlo para las demas.

Entonces lo que a mi se me ocurre es copiar la hoja que ya tengo en encuestas.xlsm y cambiarle la celda a la que hace referencia (en este caso B3 de la hoja ene-feb del archivo casos_Cerrados.xls y tambien que segun el valor que hay en esa celda (que puede ser E,MB,B,R,D) sea la columna donde ponga la formula correspondiente, de forma que se vaya llenando automaticamente las celdas correctas.

Falta decir que son muchas encuestas a llenar, por eso no las puedo hacer a mano (mas de 600), ademas de que necesito tener esto lo mas pronto posible (me dijeron que el lunes) y he buscado como copiar hojas pero es en el mismo libro donde esta la hoja a copiar, ademas de que no se como hacer para cambiarle formula de la celda y que segun el valor que contiene la celda sea donde ponga la formula.

Ojala me entiendan, si no les dejo los dos archivos para que lo entiendan mejor.

Cualquier duda me dicen.

Aqui estan los archivos

http://www.mediafire.com/?22yjydmizjg
http://www.mediafire.com/?etozmhgkmkm

Muchas gracias a todos.

LOD_Fredy · #2 (**permalink**) 20/12/2009, 15:39

He estado viendo y mencionan el uso de plantillas para ya tener el formato de la hoja en mi caso y nomas llenar los datos, estoy intentando hacer la plantilla en excel 2007 y luego crear una nueva hoja en ese libro y una vez creado empezar a meterle los datos en las celdas que correspondan (segun les explique en el primer post). Bueno sigo moviendole a ver si es posible hacer lo que les digo, facilitaria mucho las cosas el ya no hacer una copia de la hoja sino nada mas llenarla con los datos de otra hoja que esta en otro archivo.

Edito: al parecer las plantillas no funcionan como esperaba, esperaba que si creo una plantilla, y la uso en mi libro, al crear nuevas hojas ya tengan ese formato pero me aparece en blanco la nueva hoja. sigo buscandole.

Edito2:de nada sirve la plantilla, ahora estoy pensando hacer una macro que haga esto:

Realizara tantas copias de hojas como columnas de SST tenga (los SST son las columnas que tienen numeros 0900001,0900002, etc).

creo una copia de la primer hoja, le cambio el nombre por el valor que tiene la celda de la otra hoja (0900002).
limpio las celdas donde van las respuestas o sino nadamas cambio su valor por el valor de las celdas de la otra hoja (serian las celdas debajo de 09000002) y asi se haria para cada hoja, siguiendo con el llenado para el SST 0900003, etc

LOD_Fredy · #3 (**permalink**) 21/12/2009, 11:40

Ya casi solucione todo, asi que pueden cerrar el tema, gracias.

JoaoM · #4 (**permalink**) 21/12/2009, 17:33

Cita:

Iniciado por LOD_Fredy

Ya casi solucione todo, asi que pueden cerrar el tema, gracias.

OK. Sin la intervencion de algun extraño, resolviste tu problema, genial y te saludo, peeeeeeeero

Pudrias dejar la solucion acá?
Talves algun usuario la necesite ya, hoy o mañana
Gracias

LOD_Fredy · #5 (**permalink**) 03/01/2010, 13:06

Ok, dejo todo el codigo por si a alguien le interesa, la verdad se me hizo medio chafa lo que hice pero funciono que era la idea.

Ahora necesito realizar la funcion inversa de lo que pedia:

Necesito crear las graficas de barras a partir de los valores que acabo de generar, aun no se como se crea una barra desde vba, supongo se puede sin necesidad de nada a parte. Abrire el tema correspondiente.

Slu2 y gracias a todos.

Que dijeron, este se fue y no dejo el codigo, pues no es cierto:

Código:

Sub copiarENEFEB()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 1
For i = 3 To 64
Dim letra As String
letra = Switch(i = 3, "C", i = 4, "D", i = 5, "E", i = 6, "F", i = 7, "G", i = 8, "H", i = 9, "I", i = 10, "J", i = 11, "K", i = 12, "L", i = 13, "M", i = 14, "N", i = 15, "O", i = 16, "P", i = 17, "Q", i = 18, "R", i = 19, "S", i = 20, "T", i = 21, "U", i = 22, "V", i = 23, "W", i = 24, "X", i = 25, "Y", i = 26, "Z", i = 27, "AA", i = 28, "AB", i = 29, "AC", i = 30, "AD", i = 31, "AE", i = 32, "AF", i = 33, "AG", i = 34, "AH", i = 35, "AI", i = 36, "AJ", i = 37, "AK", i = 38, "AL", i = 39, "AM", i = 40, "AN", i = 41, "AO", i = 42, "AP", i = 43, "AQ", i = 44, "AR", i = 45, "AS", i = 46, "AT", i = 47, "AU", i = 48, "AV", i = 49, "AW", i = 50, "AX", i = 51, "AY", i = 52, "AZ", i = 53, "BA", i = 54, "BB", i = 55, "BC", i = 56, "BD", i = 57, "BE", i = 58, "BF", i = 59, "BG", i = 60, "BH", i = 61, "BI", i = 62, "BJ", i = 63, "BK", i = 64, "BL")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
Call copiarMARABR
Call copiarMAYJUN
Call copiarJULAGO
Call copiarSEPOCT
Call copiarNOVDIC
'ActiveWorkbook.Save
End Sub

LOD_Fredy · #6 (**permalink**) 03/01/2010, 13:09

Código:

Sub copiarMARABR()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 2
For i = 3 To 100

Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, "V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub

Código:

Sub copiarMAYJUN()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 3
For i = 3 To 138
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", _
i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", _
i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", _
i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", _
i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", _
i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", _
i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV", _
i = 101, "CW", i = 102, "CX", i = 103, "CY", i = 104, "CZ", i = 105, "DA", i = 106, "DB", _
i = 107, "DC", i = 108, "DD", i = 109, "DE", i = 110, "DF", i = 111, "DG", i = 112, "DH", _
i = 113, "DI", i = 114, "DJ", i = 115, "DK", i = 116, "DL", i = 117, "DM", i = 118, "DN", _
i = 119, "DO", i = 120, "DP", i = 121, "DQ", i = 122, "DR", i = 123, "DS", _
i = 124, "DT", i = 125, "DU", i = 126, "DV", i = 127, "DW", i = 128, "DX", _
i = 129, "DY", i = 130, "DZ", i = 131, "EA", i = 132, "EB", i = 133, "EC", _
i = 134, "ED", i = 135, "EE", i = 136, "EF", i = 137, "EG", i = 138, "EH")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub

LOD_Fredy · #7 (**permalink**) 03/01/2010, 13:11

Código:

Sub copiarJULAGO()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 4
For i = 3 To 103
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", _
i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", _
i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", _
i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", _
i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", _
i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", _
i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV", _
i = 101, "CW", i = 102, "CX", i = 103, "CY")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub

Código:

Sub copiarSEPOCT()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 5
For i = 3 To 55
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub

Código:

Sub copiarNOVDIC()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 6
For i = 3 To 20
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub

LOD_Fredy · #8 (**permalink**) 03/01/2010, 13:14

Código:

Sub LlenarEncuesta(NuevaHoja As String, i As Integer, opc As Integer)
Sheets(NuevaHoja).Select
Dim row As String

For cont = 0 To 472
row = CStr(cont + 2)
Range("C4").Select
ActiveCell.Value = "=[Casos_Cerrados_Dic_2009.xls]CERRADOS!$A$" & row
If NuevaHoja = ActiveCell.Value Then
Range("K10").Select
ActiveCell.Value = "=[Casos_Cerrados_Dic_2009.xls]CERRADOS!$A$" & row
Range("D9").Select
ActiveCell.formula = "=[Casos_Cerrados_Dic_2009.xls]CERRADOS!$AC$" & row
Range("K9").Select
ActiveCell.formula = "=[Casos_Cerrados_Dic_2009.xls]CERRADOS!$K$" & row
End If
Next
Range("C4").Select
ActiveCell.Value = ""

Dim celda As String, valor As String, formula1 As String, formula2 As String, formula3 As String, formula4 As String, formula5 As String
Dim grilla1 As String, grilla2 As String, grilla3 As String, grilla4 As String, grilla5 As String
Dim letra As String

If opc = 1 Then

letra = Switch(i = 3, "C", i = 4, "D", i = 5, "E", i = 6, "F", i = 7, "G", i = 8, "H", i = 9, "I", i = 10, "J", i = 11, "K", i = 12, "L", i = 13, "M", i = 14, "N", i = 15, "O", i = 16, "P", i = 17, "Q", i = 18, "R", i = 19, "S", i = 20, "T", i = 21, "U", i = 22, "V", i = 23, "W", i = 24, "X", i = 25, "Y", i = 26, "Z", i = 27, "AA", i = 28, "AB", i = 29, "AC", i = 30, "AD", i = 31, "AE", i = 32, "AF", i = 33, "AG", i = 34, "AH", i = 35, "AI", i = 36, "AJ", i = 37, "AK", i = 38, "AL", i = 39, "AM", i = 40, "AN", i = 41, "AO", i = 42, "AP", i = 43, "AQ", i = 44, "AR", i = 45, "AS", i = 46, "AT", i = 47, "AU", i = 48, "AV", i = 49, "AW", i = 50, "AX", i = 51, "AY", i = 52, "AZ", i = 53, "BA", i = 54, "BB", i = 55, "BC", i = 56, "BD", i = 57, "BE", i = 58, "BF", i = 59, "BG", i = 60, "BH", i = 61, "BI", i = 62, "BJ", i = 63, "BK", i = 64, "BL")
grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

formula1 = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]ENE-FEB'!" & grilla5

End If

If opc = 2 Then

letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, "V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV")
grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

LOD_Fredy · #9 (**permalink**) 03/01/2010, 13:14

Código:

formula1 = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]MAR-ABR'!" & grilla5

End If

If opc = 3 Then

letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", _
i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", _
i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", _
i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", _
i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", _
i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", _
i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV", _
i = 101, "CW", i = 102, "CX", i = 103, "CY", i = 104, "CZ", i = 105, "DA", i = 106, "DB", _
i = 107, "DC", i = 108, "DD", i = 109, "DE", i = 110, "DF", i = 111, "DG", i = 112, "DH", _
i = 113, "DI", i = 114, "DJ", i = 115, "DK", i = 116, "DL", i = 117, "DM", i = 118, "DN", _
i = 119, "DO", i = 120, "DP", i = 121, "DQ", i = 122, "DR", i = 123, "DS", _
i = 124, "DT", i = 125, "DU", i = 126, "DV", i = 127, "DW", i = 128, "DX", _
i = 129, "DY", i = 130, "DZ", i = 131, "EA", i = 132, "EB", i = 133, "EC", _
i = 134, "ED", i = 135, "EE", i = 136, "EF", i = 137, "EG", i = 138, "EH")

grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

formula1 = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]MAY-JUN'!" & grilla5

End If

If opc = 4 Then

letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", _
i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", _
i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", _
i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", _
i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", _
i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", _
i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV", _
i = 101, "CW", i = 102, "CX", i = 103, "CY")

grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

formula1 = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!" & grilla5

End If

If opc = 5 Then

letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB")

grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

formula1 = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!" & grilla5

End If

If opc = 6 Then

letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S")
grilla1 = "$" + letra + "$3"
grilla2 = "$" + letra + "$4"
grilla3 = "$" + letra + "$5"
grilla4 = "$" + letra + "$6"
grilla5 = "$" + letra + "$7"

formula1 = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!" & grilla1
formula2 = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!" & grilla2
formula3 = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!" & grilla3
formula4 = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!" & grilla4
formula5 = "='[Casos_Cerrados_Dic_2009.xls]nOV-DIC'!" & grilla5

End If


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'-----LLENA LAS ENCUESTAS DEPENDIENDO DE LA RESPUESTA ES DONDE PONE LA RESPUESTA----------------

Range("A1").Select
ActiveCell.formula = formula1
valor = ActiveCell.Value
ActiveCell.formula = ""
celda = Switch(valor = "E", "C15", valor = "MB", "E15", valor = "B", "G15", valor = "R", "I15", valor = "D", "K15")
Range(celda).Select
ActiveCell.formula = formula1

Range("A1").Select
ActiveCell.formula = formula2
valor = ActiveCell.Value
ActiveCell.formula = ""
celda = Switch(valor = "E", "C20", valor = "MB", "E20", valor = "B", "G20", valor = "R", "I20", valor = "D", "K20")
Range(celda).Select
ActiveCell.formula = formula2

Range("A1").Select
ActiveCell.formula = formula3
valor = ActiveCell.Value
ActiveCell.formula = ""
celda = Switch(valor = "E", "C25", valor = "MB", "E25", valor = "B", "G25", valor = "R", "I25", valor = "D", "K25")
Range(celda).Select
ActiveCell.formula = formula3

Range("A1").Select
ActiveCell.formula = formula4
valor = ActiveCell.Value
ActiveCell.formula = ""
celda = Switch(valor = "E", "C30", valor = "MB", "E30", valor = "B", "G30", valor = "R", "I30", valor = "D", "K30")
Range(celda).Select
ActiveCell.formula = formula4

Range("A1").Select
ActiveCell.formula = formula5
valor = ActiveCell.Value
ActiveCell.formula = ""
celda = Switch(valor = "E", "C35", valor = "MB", "E35", valor = "B", "G35", valor = "R", "I35", valor = "D", "K35")
Range(celda).Select
ActiveCell.formula = formula5
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'---------------------------------------------------------

'LIMPIA LAS CELDAS DONDE VAN LAS RESPUESTAS PARA SU POSTERIOR LLENADO CORRESPONDIENTE
Sub Limpiar(NuevaHoja As String)
Sheets(NuevaHoja).Select
Dim celda As String
Dim numero As Integer, cont As Integer, row As Integer
Dim Col As String
row = 15
Col = "C"

While row < 36 ' 15 20 25 30 35
celda = Col + CStr(row)
Range(celda).Select
ActiveCell.FormulaR1C1 = ""
row = row + 5
Wend
Col = "E"
row = 15
While row < 36 ' 15 20 25 30 35
celda = Col + CStr(row)
Range(celda).Select
ActiveCell.FormulaR1C1 = ""
row = row + 5
Wend
Col = "G"
row = 15
While row < 36 ' 15 20 25 30 35
celda = Col + CStr(row)
Range(celda).Select
ActiveCell.FormulaR1C1 = ""
row = row + 5
Wend
Col = "I"
row = 15
While row < 36 ' 15 20 25 30 35
celda = Col + CStr(row)
Range(celda).Select
ActiveCell.FormulaR1C1 = ""
row = row + 5
Wend
Col = "K"
row = 15
While row < 36 ' 15 20 25 30 35
celda = Col + CStr(row)
Range(celda).Select
ActiveCell.FormulaR1C1 = ""
row = row + 5
Wend
End Sub

Como veran es un codigo extenso aunque muy repetitivo, no supe como disminuior el codigo, tal vez despues de hacer las graficas desde vba lo intente, debo decir que no le se mucho al vba, de hecho no he usado visual basic jeje.