Jump to content

logroastur

Members
  • Content Count

    2,675
  • Joined

  • Last visited

  • Days Won

    25

2 Followers

About logroastur

  • Rank
    Advanced Member

Contact Methods

  • Website URL Array

Profile information

  • Gender Array

Recent Profile Visitors

1,109 profile views
  1. Buenas @Lázaro Chequea archivo Un saludo Resumen Coincidencias.rar
  2. Buenas @CBAEZ Puedes chequea el Tema (extraer-impuestos-de-un-xml-de-factura-electronica) en el se encuentra el archivo (GetValuesCFDI) que realiza lo que solicitas Un saludo
  3. Buenas @JSDJSD Puedes usar Private Sub UserForm_Initialize() Dim hoja As Worksheet Dim u As Long Dim datos() Dim i As Long u = Worksheets.Count ReDim datos(1 To u) For Each hoja In Sheets i = i + 1 datos(i) = hoja.Name Next OrdenarLista datos End Sub Private Sub OrdenarLista(Vector As Variant) Dim iMin As Long Dim iMax As Long Dim Vectemp As String Dim Pos As Long Dim i As Long iMin = LBound(Vector) iMax = UBound(Vector) While iMax > iMin Pos = iMin For i = iMin To iMax - 1 If Vector(i) > Vector(i + 1) Then Vectemp = Vector(i + 1) Vector(i + 1) = Vector(i) Vector(i) = Vectemp Pos = i End If Next i iMax = Pos Wend ListBox1.List() = Vector End Sub Un saludo
  4. Buenas @Berlin Puedes usar En celda B3, coloca esta formula =SI(ESNUMERO(B3);CONCATENAR(SI(CONTAR.SI($K$5:$K$18;B3);"FESTIVO";"");SI(Y(DIASEM(B3;2)>5;CONTAR.SI($K$5:$K$18;B3));" y ";"");SI(DIASEM(B3;2)>5;MAYUSC(TEXTO(B3;"dddd"));""));"") y luego expande en las celdas necesitadas En formato condicional Selecciona las celdas A3:B33 y coloca las siguientes formulas Festivos: =Y(ESNUMERO($B3);CONTAR.SI($K$5:$K$18;$B3)) Sábados =Y(ESNUMERO($B3);DIASEM($B3;2)=6;CONTAR.SI($K$5:$K$18;$B3)=0) Domingos =Y(ESNUMERO($B3);DIASEM($B3;2)=7;CONTAR.SI($K$5:$K$18;$B3)=0) Un saludo
  5. Buenas @Luis Perez Puedes chequear Tema (extraer-impuestos-de-un-xml-de-factura-electronica) archivo (GetValuesCFDI) Un saludo
  6. Buenas @Mauri135 O puedes usar Para solo el valor Sub GetCurrenciesEUR_USD() Dim strUR As String Dim strDV As String Dim strTP As String Dim obj As Object Dim objDoc As Object Dim objDV As Object Dim objSP As Object Dim objTP As Object Dim dato As String Dim strERR As String strDV = "top bold inlineblock" strUR = "https://www.investing.com/currencies/eur-usd-historical-data" Set obj = CreateObject("WinHttp.winHttpRequest.5.1") With obj .Open "GET", strUR, False .Option(0) = 13056 .Option(12) = "http-user-agent=Mozilla/5.0 (Windows NT 10.0; WOW64; rv:48.0) Gecko/20100101 Firefox/48.0" .Send If .Status = 200 Then Set objDoc = CreateObject("htmlfile") objDoc.Write .responseText Else strERR = .statustext End If End With Set obj = Nothing If Not objDoc Is Nothing Then Set objDV = objDoc.getElementsByTagName("div") If Not objDV Is Nothing Then For Each objTP In objDV strTP = "" On Error Resume Next strTP = objTP.className On Error GoTo 0 If strTP = strDV Then dato = objTP.innertext Exit For End If Next Else strERR = "No se puede tener acceso" End If Set objDV = Nothing Else strERR = "No se puede tener acceso" End If Set objDoc = Nothing If strERR = "" Then MsgBox dato, vbInformation, Application.OrganizationName Else MsgBox strERR, vbExclamation, Application.OrganizationName End If End Sub O para todos los datos Sub GetTableCurrenciesEUR_USD() Dim strUR As String Dim strDV As String Dim strTP As String Dim obj As Object Dim objDoc As Object Dim objTB As Object Dim objTP As Object Dim objTH As Object Dim objTR As Object Dim objTD As Object Dim dato As String Dim datos() Dim c As Long Dim i As Long Dim n As Long Dim u As Long Dim ii As Long Dim strERR As String strTP = "curr_table" strUR = "https://www.investing.com/currencies/eur-usd-historical-data" Set obj = CreateObject("WinHttp.winHttpRequest.5.1") With obj .Open "GET", strUR, False .Option(0) = 13056 .Option(12) = "http-user-agent=Mozilla/5.0 (Windows NT 10.0; WOW64; rv:48.0) Gecko/20100101 Firefox/48.0" .Send If .Status = 200 Then Set objDoc = CreateObject("htmlfile") objDoc.Write .responseText Else strERR = .statustext End If End With Set obj = Nothing If Not objDoc Is Nothing Then Set objTB = objDoc.getElementById(strTP) If Not objTB Is Nothing Then u = objTB.Rows.Length c = objTB.Rows(1).Cells.Length ReDim datos(1 To u, 1 To c) For Each objTR In objTB.Rows i = i + 1 ii = 0 For Each objTH In objTR.Cells ii = ii + 1 dato = objTH.outerText datos(i, ii) = dato Next Next Else strERR = "No se puede tener acceso" End If Set objTB = Nothing Else strERR = "No se puede tener acceso" End If Set objDoc = Nothing If strERR = "" Then Hoja1.Range("B3").Resize(u, c).Value = datos MsgBox "Finalizada la extración", vbInformation, Application.OrganizationName Else MsgBox strERR, vbExclamation, Application.OrganizationName End If End Sub Un saludo
  7. Buenas @jmadridporto2025 Para una combinación simple, usa Sub GetAllCombis() Dim c As Long Dim i1 As Long Dim i2 As Long Dim i3 As Long Dim i4 As Long Dim n As Long Dim s As Long Dim u As Long Dim v() u = 16 ' Número de Partidos c = ((u * 2) * u) ' Número de combinaciones n = ((u * 2) * u) + (u * 2) ' Nùmero de combinaciones con titulos ReDim v(1 To n, 1 To 3) For i1 = 2 To 3 For i2 = 1 To u s = s + 1 ' Se crea el tiulo de columna v(s, 1) = "Partido" v(s, 2) = "Alta" v(s, 3) = "Baja" For i3 = 1 To i2 s = s + 1 v(s, 1) = Hoja1.Range("A" & i3 + 1).Value v(s, i1) = "x" Next If i2 < u Then For i4 = i2 + 1 To u s = s + 1 v(s, 1) = Hoja1.Range("A" & i4 + 1).Value v(s, IIf(i1 = 2, 3, 2)) = "x" Next End If Next Next Hoja2.Range("A2").Resize(s, 3).Value = v MsgBox "Se crearon " & c & " combinaciones", vbInformation, Application.OrganizationName End Sub Un saludo
  8. Buenas @marroco312 Aunque el compañero @Riddle ya te dio una solución y no la he visto aún Chequea esta otra posible, espero no sea la misma Un saludo Filtro.rar
  9. Buenas @German Veamos con la escasa información que muestras, es materialmente imposible que te pueda dar una posible solución. La información que se debe de saber es la siguiente 1º ver el valor del objeto wbb 2º comprobar que se cargo correctamente la pagina Para ello 1º cambiar el tamaño del wbb para que se vea 2º en el error verifica los valores de wbb en la ventana de VBA en Ventana Locales, en ella comprueba los valores de wbb.document Bien con dicha información podrás saber el por que no funciona Un saludo
  10. Buenas @German Chequea archivo Get TGSS - Web | Logroastur Software Modo descarcarga Un saludo
  11. Buenas Video ejemplo Descargar con Links Publicidad Archivo directo Un saludo
  12. Buenas @Cacho R Sin ganas de perder el tiempo en "discusiones de peces", cosa aparte de que no inicie la "discusión", solo te indico que antes de "lanzar" (y lo dejo entrecomillas) un comentario de que es un posible virus, te reitero que lo lógico es que se medio verifique dentro de posible, por una sencilla razón, lo que se lanza en las redes(y al fin y acabo estos es una red) la mitad de la gente se lo toma al pie de la letra sin contrastar, "a si salen el noventa de los bulos que existen en internet". al menos eso me parece. Bien en cuanto a subir el archivo al servidor del foro, es un punto aparte, y por el momento solo lo realizo cuando los archivos son totalmente creados por mi y si se visualiza el gif se vera que no hay problema alguno para realizar la descarga. Bien como lo que estamos quitar importancia a la consulta, lo dicho por mi parte cierro el punto de la "discusión" puesto lo que importa es la consula Un saludo
  13. Buenas @Cacho R Y para terminar los links de descarga tampoco poseen virus alguno Reporte Link Consulta Link 1 Link Reporte Link Reporte virustotal Consulta Link1 Captura de pantalla Reporte Reporte virustotal - Link2 Link Reporte virus Consulta Link2 Captura de pantalla Bien lo dicho anteriormente, espero tus( @Cacho R ) comentarios Un saludo
  14. Buenas @Cacho R Siento indicarte que no es correcto, el archivo no posee ningún virus, ni cosa rara Reportes de https://www.virustotal.com/ Del archivo Zip Link para ver el reporte completo Reporte virustotal - Consulta.zip Captura de pantalla Reporte del excel Link para ver el reporte completo Reporte virustotal - Consulta.xls Captura de pantalla Bien @Cacho R como ves no es correcto, y como comentario antes de dar algo como real se debe de verificar, pues aunque no lo parezca el comentario que realizaste escomo si yo deseo que se infecte algún usuario y esto no es verdad por lo que solicito que rectifiques tu comentario Un saludo
  15. Buenas @CarlosKurt Chequea archivo Extraer información Web Para realizar la descarga chequea gif Gif Proceso Descarga Un saludo
×
×
  • Create New...

Important Information

Privacy Policy

Ayuda Excel - Madrid, Madrid, ES - Valorada por 6254 personas - Aprender Excel - Total: 4.7 / 5