Acortar opciones del menu para mayor síntesis
En otra pregunta que realice anteriormente me hiciste una macro que me ordena día a día los menu por persona pero necesitaría que solo me lo ordene por las palabras que están adelante de los dos puntos
Porque sino seria muy extensa por ejemplo
Lunes
BETI JAI: Pollo horneado con Mostaza, miel y ajo con papas noisette.
En la hoja cembrass solo debería poner
BETI JAI
Martes
BETI JAI: Milanesa de cerdo napolitana con pure mixto.
En la hoja de cembrass solo debería poner
BETI JAI
No se si se entiende
O de lo contrario que se modifiquen todo lo esta en la hoja respuesta de formulario 1
Se cambien todos los menúes que empiecen por beti jai se reemplacen solo por esas palabras
Todos los que empieces por pastas solo deje eso, pastas
Así con el menu light y con el menu CLÁSICO
Acá dejo ejemplos de como me aparecen los menu pasta separado de manera desglosado y en la segunda más general como lo necesito
1 Respuesta
Te paso la macro actualizada para recortar el menú por las palabras que se encuentran antes de los dos puntos ":"
Sub PasarDatos()
'Por Dante Amor
Dim i As Long, j As Long, k As Long, n As Long, nmax As Long
Dim a As Variant, b As Variant, ky As Variant
Dim sh1 As Worksheet, sh2 As Worksheet
Dim cad As String
Dim dic As Object
Dim rng As Range
'
Application.ScreenUpdating = False
'
Set sh1 = Sheets("Respuestas de formulario 1")
Set sh2 = Sheets("Cembrass")
Set dic = CreateObject("Scripting.Dictionary")
Set rng = sh1.Range("A1:F" & sh1.Range("A" & Rows.Count).End(3).Row)
'
If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
a = rng.Value
ReDim b(1 To UBound(a, 1) * 4, 1 To 5)
sh2.Rows("4:" & Rows.Count).Clear
dic.CompareMode = vbTextCompare
'
For j = 2 To UBound(a, 2) 'ciclo de columnas de B a F
For i = 2 To UBound(a, 1) 'ciclo de filas de 2 en adelante
If a(i, j) <> "" Then
If InStr(1, a(i, j), ":") > 0 Then
cad = Split(a(i, j), ":")(0)
Else
cad = a(i, j)
End If
dic(cad) = Empty
End If
Next
Next
'
k = 4
For Each ky In dic.keys
nmax = 0
For j = 2 To UBound(a, 2) 'ciclo de columnas de B a F
rng.AutoFilter j, ky & "*"
n = sh1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If n > nmax Then nmax = n
If j = 2 Then
With sh2.Cells(k, j)
.Value = ky
.Resize(1, 5).HorizontalAlignment = xlCenter
.Resize(1, 5).MergeCells = True
End With
End If
sh2.Cells(k + 1, j).Value = n
sh1.AutoFilter.Range.Columns(1).Offset(1).Copy sh2.Cells(k + 2, j)
sh1.ShowAllData
Next
k = k + nmax + 2
Next
sh2.Range("B4:F" & k - 1).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub[Revisa los resultados y comentas si tienes alguna duda.
Seria mucho pedir que el orden en que apareecen en la hoja de cembras sea el siguiente
BETI JAI
PASTAS
LIGHT
CLÁSICO
PBT JAMÓN Y QUESIO
Si no se puede igual así esta perfecto
Valora esta respuesta.
El orden que sugieres no es alfabético, entonces tendría que agregar un nuevo código para ordenarlo en la manera que necesitas.
Crea una nueva pregunta. En la nueva pregunta debes poner tus "palabras claves" ordenadas en alguna hoja, en alguna columna. Por ejemplo, en la misma hoja "Respuestas de formulario 1" en la columna AA pones el orden en que quieres que aparezcan.
Hola si en vez de los dos puntos habría la palabra "con"
Que parte debería cambiar en la macro
Cambia lo siguiente:
If InStr(1, a(i, j), "con") > 0 Then cad = Split(a(i, j), "con")(0)
