Jump to content

Antoni

Members
  • Content Count

    10,379
  • Joined

  • Last visited

  • Days Won

    581

Everything posted by Antoni

  1. Recuerda que tienes la misma consulta abierta en otro foro, no la dejes colgada aunque te la solucionen aquí.
  2. Suponiendo que actúas sobre la columna A. Pon en la hoja esta macro. Private Sub Worksheet_Change(ByVal Target As Range) Dim Carpeta As String On Error Resume Next If Target.Address Like "$A$*" Then '<----- corregir si es necesaio Carpeta = ThisWorkbook.Path & "\" & Target.Value If Dir(Carpeta, 16) = "" Then MkDir (Carpeta) ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Carpeta End If End If End Sub Y por favor, no dejes de beber,.......🤣🤣🤣
  3. Un textbox es un texto y como tal pasará a la celda.
  4. Tenía esto por ahí, si te vale, ........ Ejemplo (1) (1).xlsm
  5. Abre el adjunto y pulsa sobre la flecha azul. Vale para cualquier número de agentes e intervalos de fechas. tablasmes.xlsm
  6. Yo creo que andas buscando algo parecido a esto, pero como reduces el tema a un simple mensaje en un textbox, sin explicar cual es el problema, que tienes y que quieres conseguir. Ejercicio msgbox de celda con variable incluida-1.xlsm
  7. NO, esta instrucción pregunta por la cantidad de registros recuperados del Select Count.
  8. Sube tu archivo para ver a lo que te refieres.
  9. Solo tienes que añadir condiciones al Select Count. sql = "select count(*) from Tabla1 where " & _ "Id=" & Cells(x, 1).Value & " and " & _ "Nombre=" & "'" & Cells(x, 2).Value & "' and " & _ "Codigo=" & "'" & Cells(x, 3).Value & "'"
  10. A ver si lo he entendido: Hoja05.Cells(5, 9) = (100 - CDbl(Prop)) / 100
  11. Si no me he equivocado: Private Sub CommandButton1_Click() If ComboBox1.ListIndex > -1 And _ ComboBox2.ListIndex > -1 And _ IsNumeric(TextBox1) And _ Not ComboBox1.ListIndex > ComboBox2.ListIndex Then For x = ComboBox1.ListIndex To ComboBox2.ListIndex Range("B" & x + 2) = CDbl(TextBox1) Next Else MsgBox "Datos erróneos", vbCritical End If End Sub
  12. Yo me aburría y he hechos esto, lo mismo, pero a mi manera. 🙂 Prueba 1 10-04-2020.xlsm
  13. Sube un archivo Excel con un ejemplo de tu consulta, porque no se acaba de entender lo que quieres.
  14. Solo tienes que escribir en la columna A de la hoja ARTÍCULOS. Puedes parametrizar los colores en la hoja COLORES De paso, te adjunto un archivo con una opción para una lista de validación múltiple. Colorear palabras.xlsm Lista de validación múltiple.xlsm
  15. Sube tu archivo, porqué, efectivamente, no lo has hecho bien.
  16. Después de ejecutar la macro Click, me aparece así. ¿He hecho algo mal? Saludos amigo
  17. Una más: Sub Resumen() Dim BASE, ANUAL, FILA, COLUMNA, TEXTO, UFILA, UCOLUMNA '-- Set BASE = Sheets("BASE") Set ANUAL = Sheets("ANUAL") '-- UFILA = ANUAL.Range("A" & Rows.Count).End(xlUp).Row + 1 UCOLUMNA = ANUAL.Cells(1, Columns.Count).End(xlToLeft).Column + 1 ANUAL.Range("C2", ANUAL.Cells(UFILA, UCOLUMNA)).ClearContents '-- For x = 2 To BASE.Range("A" & Rows.Count).End(xlUp).Row If Not UCase(BASE.Range("O" & x)) = "RECHAZADO" Then Set FILA = ANUAL.Columns("A").Find(BASE.Range("E" & x), , xlValues, xlWhole) Set COLUMNA = ANUAL.Rows(1).Find(BASE.Range("I" & x), , xlValues, xlWhole) If Not FILA Is Nothing And Not COLUMNA Is Nothing Then TEXTO = "|" & BASE.Range("C" & x) & "-" & BASE.Range("D" & x) & "-" & Format(BASE.Range("M" & x), "0.00") If ANUAL.Cells(FILA.Row, COLUMNA.Column) = "" Then TEXTO = Mid(TEXTO, 2) ANUAL.Cells(FILA.Row, COLUMNA.Column) = ANUAL.Cells(FILA.Row, COLUMNA.Column) & TEXTO End If End If Next End Sub
  18. Lo mismo, de otra manera sin considerar los acentos. Function Similitud_Porcentual(Cadena1 As String, Cadena2 As String) As Integer Dim Texto1 As Variant, Texto2 As Variant, x As Integer, Veces As Integer If Cadena1 = "" Or Cadena2 = "" Then Exit Function '-- Cadena1 = Homogeneizar(LCase(Cadena1)) Cadena2 = Homogeneizar(LCase(Cadena2)) '-- Texto1 = Split(Cadena1) Texto2 = Split(Cadena2) Total = UBound(Texto1) + 1 If UBound(Texto2) > UBound(Texto1) Then Total = UBound(Texto2) + 1 '-- For x = 0 To UBound(Texto1) If UBound(Filter(Texto2, Texto1(x))) > -1 Then Veces = Veces + 1 End If Next Similitud_Porcentual = Round(Veces * 100 / Total, 0) End Function Function Homogeneizar(Cadena As String) As String Homogeneizar = Replace(Cadena, "á", "a") Homogeneizar = Replace(Homogeneizar, "é", "e") Homogeneizar = Replace(Homogeneizar, "í", "i") Homogeneizar = Replace(Homogeneizar, "ó", "o") Homogeneizar = Replace(Homogeneizar, "ú", "u") Homogeneizar = Replace(Homogeneizar, "ü", "u") End Function
  19. Otra versión mas: Public Sub Elegir_Palabra_III() Sheets("Juego").Range("C7") = "" For Each Fila In Sheets("Palabras").Range("B2").CurrentRegion.Rows If Sheets("Palabras").Range("D" & Fila.Row) = 1 Then Sheets("Juego").Range("C7") = Sheets("Palabras").Range("B" & Fila.Row) Exit For End If Next End Sub
  20. Ya que lo tenía hecho, lo subo por si te sirve de algo. La misma macro de 2 formas distintas. Public Sub Elegir_Palabra() Hoja2.Range("C7") = "" For x = 2 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row 'Última fila If Hoja1.Range("D" & x) = 1 Then Hoja2.Range("C7") = Hoja1.Range("B" & x) Exit For End If Next End Sub Public Sub Elegir_Palabra_II() Sheets("Juego").Range("C7") = "" For x = 2 To Sheets("Palabras").Range("B" & Rows.Count).End(xlUp).Row 'Última fila If Sheets("Palabras").Range("D" & x) = 1 Then Sheets("Juego").Range("C7") = Sheets("Palabras").Range("B" & x) Exit For End If Next End Sub
×
×
  • Create New...

Important Information

Privacy Policy