You are here:--CORTESIA
CORTESIA2020-02-06T14:14:02+02:00

Home Forum Domande su Excel Generale CORTESIA

Tag: 

  • Autore
    Articoli
  • Avatargiorgioantonio
    Partecipante
      Post totali: 387

      Salve a tutti,
      vorrei l’indirizzo per scaricare le estrazioni del lotto.

      Potrebbe favorirmi qualcuno?

      Grazie

      Giorgioantonio

    • BySalvBySalv
      Amministratore del forum
        Post totali: 630

        Ciao Giorgio io uso questa macro

        Public sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet
        Public rr, Rt, rG, Rc, cc, S1
        
        Sub SetFG()
        Set sh1 = Worksheets("Ambate")
        Set sh2 = Worksheets("Appo2")
        Set sh3 = Worksheets("Appoggio")
        Set sh4 = Worksheets("Archivio")
        Set sh5 = Worksheets("Gest")
        End Sub
        Sub Lotto() 'aggiornamento internet
        Dim r, c, r1, r2, x, y, z, rx, rk, cx, c1, n, dd, ds, wd, ss, dat()
        
        SetFG
        sNo
        sh3.Visible = True
        sh3.Activate
        sh3.Cells.ClearContents
        On Error GoTo 1
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;https://www.lottoced.com/lotto", Destination:=Range("$A$1"))
        '        .CommandType = 0
                .Name = "lotto_1"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            r1 = sh3.Cells(Rows.Count, 1).End(xlUp).Row
            r2 = sh4.Cells(Rows.Count, 1).End(xlUp).Row
            For x = 1 To r1
                If sh3.Cells(x, 1) = "BARI" Then
                    ss = Split(sh3.Cells(x - 1, 1), " ")
                    dd = CDate(ss(3) & "/" & ss(2) & "/" & ss(1))
                    If sh4.Cells(r2, 2) = dd Then GoTo 1 Else r2 = r2 + 1
                    sh4.Cells(r2, 1) = sh4.Cells(r2 - 1, 1) + 1
                    sh4.Cells(r2, 2) = dd
                    If Month(sh4.Cells(r2, 2)) <> Month(sh4.Cells(r2 - 1, 2)) Then
                      sh4.Cells(r2, 59) = 1
                      sh4.Cells(r2, 60) = 1
                      sh4.Cells(r2, 83) = 1
        '              sh2.Cells(10, 3) = 1
                    Else
                      sh4.Cells(r2, 59) = sh4.Cells(r2 - 1, 59) + 1
                      sh4.Cells(r2, 60) = sh4.Cells(r2 - 1, 60) + 1
                      sh4.Cells(r2, 83) = sh4.Cells(r2 - 1, 83) + 1
        '              sh2.Cells(10, 3) = sh4.Cells(r2 - 1, 60) + 1
                    End If
                    
                    c1 = 3
                    n = 0
                    For y = x To x + 10
                        For z = 2 To 6
                            sh4.Cells(r2, c1) = sh3.Cells(y, z)
                            c1 = c1 + 1
                        Next z
                    Next y
                    Exit For
                End If
            Next x
            sh1.Cells(1, 9) = 0
        '    sh2.Cells(1, 47) = 0
        '    sh6.Cells(1, 47) = 0
        MsgBox "Estrazione Inserita", vbInformation, "Scrittura dati"
        1:
        sh1.Activate
        sSi
        End Sub

        non so riuscirai comunque aggiungi i fogli come sono nominati in SetFg(), basta lanciare solo la macro lotto.

        ciao by sal

      • Avatargiorgioantonio
        Partecipante
          Post totali: 387

          Grazie infinite By-Sal

        Devi essere loggato per rispondere a questa discussione.

        Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

        Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

        Chiudi