You are here:Home-Domande su Excel Generale-CORTESIA
CORTESIA2020-02-06T14:14:02+01:00

Home Forum Domande su Excel Generale CORTESIA

Taggato: 

Visualizzazione 2 filoni di risposte
  • Autore
    Post
    • Avatargiorgioantonio
      Partecipante
        Post totali: 436

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

        Potrebbe favorirmi qualcuno?

        Grazie

        Giorgioantonio

      • BySalvBySalv
        Amministratore del forum
          Post totali: 697

          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

          Ciao By Sal (8-)
          se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

        • Avatargiorgioantonio
          Partecipante
            Post totali: 436

            Grazie infinite By-Sal

        Visualizzazione 2 filoni di risposte
        • Devi essere connesso per rispondere a questo topic.