Pagina 2 di 2 primaprima 1 2
Visualizzazione dei risultati da 11 a 12 su 12
  1. #11
    Utente di HTML.it L'avatar di oregon
    Registrato dal
    Jul 2005
    residenza
    Roma
    Messaggi
    36,347
    Leggi bene la mia risposta e fornisci chiarimenti sul codice che hai usato, commenta le righe e cosa fanno e dicci che errori hai (codici e messaggi durante l'esecuzione), dacci un tuo parere, ragioniamo insieme, non chiedere solo una soluzione.

    Vale in questo e in tutti gli altri forum... (non cambia nulla se cambia Papa...).

    Buona Pasqua
    No MP tecnici (non rispondo nemmeno!), usa il forum.

  2. #12
    La mia richiesta e sempre la stessa ; Fatta ieri.
    E cio� : Come puoi vedere dal mio listato, ho inserito il termine (row) perch� questo sito usa una forma Tabellare da quanto ho capito io.
    Pertanto se metto in entrambi le posizioni il termine (row) esso mi prende tranquillamente la prima parte dei dati che sono: (" Data - localit� - Perturbazione in percentuale ecc...! ")
    Mentre il termine (table e div ) dovrebbe prendere tutto il resto come si vede nell'immagine che ho inserito ieri nel mio primo post.

    Ora il problema e questo: Se uso come ho gi� detto e fatto in precedenza il termine (row) la prima parte viene estratta
    Al contrario non so come estrarre i dati inerente alle Mn o Max anche solo della prima fila di dati Proprio come si vede nell'immagine
    Tutto qui .
    E pensare che in un altro progetto fatto in un altro foglio di excel , riesco ad estrarre qui tutto quanto
    Purtroppo per� in questo caso ; L'estrazione di tutti i dati avvengono tutti in una sola cella.
    Pertanto sono punto e a capo.
    E non s� come risolvere questo problema.
    Per� se magari tu che sei decisamente pi� capace di me
    Prova a dare un occhiata a questo listato ; Che � poi quello che ti ho appena descritto
    Solo che ripeto il tutto avviene solo nella cella (B13)

    Sempre ch� non commetta qualche cosa che non va
    Questo e il Listato N.2 :
    codice:
    Option Explicit
    
    Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    
    
    Dim Campo As Range
    Dim IE
    Dim Forma As Object
    Dim myStart
    Dim Y As String, X As String
    Dim Getimgurl As HeaderFooter
    
    
    Dim rngTarget As Range
    Dim getElementsByTagName As Variant
    Dim getElementsByClassName As Variant
    Dim innerText As Variant
    
    
    Dim OggCol As Object, OggCol1 As Object, OggCol2 As Object, OggCol3 As Object, OggCol4 As Object, OggCol5 As Object, OggCol6 As Object, OggCol7 As Object, OggCol8 As Object, OggCol9 As Object, OggCol10 As Object
    Dim cell, shp As Shape, Target As Range
    Dim rng As Object
    Dim filenam As Variant
    Dim I As Long
    
    
    Dim cel As Variant, Text As Variant, Riga As Variant, UltimaRiga As Variant, Search As Variant, SearchRange As Variant, MyStr As Variant, MyStr2 As Variant, UpperCase As Variant, UpperCase2 As Variant
    
    
    Dim Domanda As String, Domanda2 As String
    
    
    Sub Previsioni_Meteo(ByVal myURL As String)
    On Error GoTo finish
    
    
    X = Foglio1.Range("D1").Value & ""
    
    
    'Va Chiamata passandogli l'URL da leggere
    myURL = "https://www.3bmeteo.com/meteo/" & X & ""
    
    
    Set IE = CreateObject("InternetExplorer.Application")
       
    With IE
    .Navigate myURL
    .Visible = True
    
    
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    
    
    End With
    
    
    Do
        DoEvents
        If Timer > myStart + 2 Or Timer < myStart Then Exit Do
    Loop
    
    
    'Scrive sul Foglio Attivo
    On Error Resume Next
    
    
    Set OggCol = IE.Document.getElementsByClassName("row") '- Localit� Me1teo
    Set OggCol1 = IE.Document.getElementsByClassName("table") '(0).innerText         '- Minima Attuale
    
    
    Set OggCol2 = IE.Document.getElementsByClassName("table")
    'Set OggCol4 = OggCol1(1).getElementsByTagName("glider-track")(0).innerText
    
    
    With IE.element.getAttribute("table")
    Sheets("Meteo").Range("B14").Value .getAttribute("=col-xs-1.2")(0).innerText
    'Sheets("Meteo").Range("B11").Value = ("=col-xs-1-3 col-sm-3-5") & innerText
    
    
    Sheets("Meteo").Cells(8, 2) = OggCol(0).innerText
    
    
    Sheets("Meteo").Cells(13, 2) = OggCol2(0).innerText
    
    
    End With
    
    
    
    
    
    
    'Sheets("Meteo").Cells(13, 0) = OggCol(0).innerText
    '���������������������������������������������������������������������������������
    'For I = 1 To OggCol1.Length
    
    
    'With Foglio1
    
    
    '.Range("B30").Offset(I, 0) = OggCol3(I).getAttribute("src")
    
    
    
    
    'End With
    
    
    'Next I
    
    
    '################################################################################
    'X = Mid(Foglio1.Range("B13").Value, 70)
    
    
    'Foglio1.Range("B9").Value = "" & X
    
    
    
    
    
    
    '################################################################################
    'Range("A11").VerticalAlignment = xlCenter
    
    
    'Foglio1.Range("A:B").WrapText = True
    
    
    'Foglio1.Range("A1").Select
    
    
    '################################################################################
    'Chiusura IE
    'IE.Quit
    Set IE = Nothing
    
    
    Call Preleva_I_Dati_Dalla_Cella_web
    'Call dividi
    finish:
    End Sub
    
    
    Sub Preleva_I_Dati_Dalla_Cella_web()
    'Contatore per la scrittura di parole trovate
    Riga = 2
    
    
    'Svuota l'ultima ricerca
    UltimaRiga = ThisWorkbook.Worksheets("Meteo").Range("L1").End(xlDown).Row
    If ThisWorkbook.Worksheets("Meteo").Range("L2") <> "" Then
        ThisWorkbook.Worksheets("Meteo").Range("L2:L" & UltimaRiga).ClearContents
    End If
    
    
    Set Search = ThisWorkbook.Worksheets("Meteo").Range("K2:K100")
    Set SearchRange = ThisWorkbook.Worksheets("Meteo").Range("B13")
     
    For Each cel In SearchRange
        For Each Text In Search
            If InStr(cel, Text) Then
                Debug.Print "Trovato " & Text & " alla cella " & cel.Address
    
    
                'Scrivere le parole trovate
                ThisWorkbook.Worksheets("Meteo").Range("L" & Riga).Value = Text
                Riga = Riga + 1
            End If
        Next Text
    Next cel
    
    
    Call Rendi_La_Prima_Letta_In_Maiuscolo
    End Sub
    
    
    Sub Rendi_La_Prima_Letta_In_Maiuscolo()
    'Domanda = InputBox("Inserire il Tuo Nome Grazie...!")
    Domanda = Foglio1.Range("L2").Value
    Domanda2 = Foglio1.Range("L3").Value
    
    
      MyStr = Domanda
       MyStr2 = Domanda2
    
    
    UpperCase = Left(Domanda, 1)
    UpperCase2 = Left(Domanda2, 1)
      'Foglio1.Range("A3").Value = "Ciao"
        Foglio1.Range("L2").Value = UCase(UpperCase) + Mid(Domanda, 2, 15)
    Foglio1.Range("L3").Value = UCase(UpperCase2) + Mid(Domanda2, 2, 15)
    
    
    Call Preleva_Solo_I_Dati_Interessati
    End Sub
    
    
    Sub Preleva_Solo_I_Dati_Interessati()
    
    
    'Foglio1.Range("A6:C6").WrapText = True
    
    
    With Foglio1
    .Range("L2").Copy
    .Range("B9").PasteSpecial
    
    
    .Range("L3").Copy
    .Range("B10").PasteSpecial
    
    
    End With
    
    
    'Foglio1.Range("B13").Select
    'Foglio1.Range("B13").Clear
    
    
    'Call Converti_In_Maiuscol_a_Prima_Lettera
    
    
    End Sub
    
    
    Sub Converti_In_Maiuscol_a_Prima_Lettera()
    Dim Stringa, Parola
    Dim Righe, R, Colonne
    Dim Intervallo As Range
    ' prima fase: determino li'intervallo su cui lavorare
    With Range("L2").Value
    Righe = .Rows.Count
    Colonne = .Columns.Count
    Set Intervallo = .Resize(Righe, Colonne)
    End With
    If IsEmpty(Intervallo) Then
    MsgBox "L'intervallo � vuoto"
    Exit Sub
    End If
    ' seconda fase: conversione delle stringhe mettendo in maiuscolo i soli primo caratteri
    For R = 1 To Righe
    Stringa = Intervallo(R, 1)
    If Stringa <> "" Then
    Parola = StrConv(Stringa, vbProperCase)
    Intervallo(R, 1) = Parola
    End If
    Next
    
    
    'Call Rimuovi_Il_Ritorno_A_Capo_Delle_Celle
    End Sub
    
    
    
    
    
    
    Sub Rimuovi_Il_Ritorno_A_Capo_Delle_Celle()
         Dim Intervallo As Range
         Application.ScreenUpdating = False
         Application.Calculation = xlCalculationManual
    
    
         For Each Intervallo In ActiveSheet.UsedRange
            If 0 < InStr(Intervallo, Chr(10)) Then
                Intervallo = Replace(Intervallo, Chr(10), "")
            End If
         Next
    
    
    
    
    
    
         Application.ScreenUpdating = True
         Application.Calculation = xlCalculationAutomatic
         
    
    
    End Sub
    A.Maury1704

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi
  •  
Powered by vBulletin® Version 4.2.1
Copyright © 2021 vBulletin Solutions, Inc. All rights reserved.