Aiuto per file excel...

[AntonioPatella]

Ciao a tutti amici del forum, vi seguo da tanto e sono onorato di far parte di questa community, anche seè da pochissimo che sono iscritto...
Allora il mio problema è il seguente:
uso un file excel che, tramite una query we,b importa dei dati da un sito esterno...

Il problema è che non essendo sempre in casa per motivi di lavoro, nn lo posso aggiornare manualmente, ma questo è il problema minore, perchè ho impostato un aggiornemento ogni 5 min ed è ok, il vero problema è conservare uno storico dei dati, in un altro foglio, aggiungendo ad ogni refres quelli nuovi senza perdere i vecchi...

Poi siccome nn mi occorrono tutti i dati che scarico, effettuo dei filtri, ma per risolvere questo problema dovrei allegare il file per farvelo vedere e nn so prorpio come fare...
Ma se possibile risolviamo un problema alla volta.

Vi ringrazio a presto!
Antonio

[Gigi_]

Ciao e benvenuto,
leggi questo topic http://www.pc-facile.com/forum/viewtopic.php?f=26&t=98547 e magari nello stesso chiedi a raimea di postare la soluzione finale poi magari la si può adattare...
ps....sei murgiano??

[AntonioPatella]

NO!
Salentino...di Lecce (città)!!!

Grazie per la risposta i faccio sapere...

[Gigi_]

..ehiii vabbè ho sbagliato di 150 km!!! puro tie sinti ppùiese!

[AntonioPatella]

Sine Compare miu!!!

[AntonioPatella]

Non ci sto capendo molto, nn ci sarebbe un file già pronto?

Grazie

[raimea]

ciao

grazie a gigi_ ho una macro che mi preleva dati , li mette in fgl prelievo , e mi copia solo alcune partite in fgl studio , ad ogni prelievo.

in col U9 , in giu' scrivo il numero delle partite da "studiare" e me le ritrovo gia in fgl studio.

Codice: Seleziona tutto

Option Base 1
Public objIE As Object
Public a As Variant
Public url As String
Public linkpb(500, 15) As String
Public p(12, 6) As Variant
Public ck(6, 500) As Variant
Public rif, rifrif, fine, inizio As Variant
Public d(12)


Sub estrailinkpb()

userform1.Show vbModeless
DoEvents
inizio = Timer1

myDate = Int(Now())
url = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=" & Day(myDate) _
    & "&dm=" & Month(myDate) & "&dy=" & Year(myDate) & "&df=1&dw=3"

Naviga (url)

Range("B9:R1000").ClearContents

   
parametri
destinazioni

numero = quanteVolte(a, "tbl_") / 19

            rifrif = 0
            For link = 1 To numero ' Sheets("prelievo").Cells(2, 5).Value
           
                    For data = 1 To 12
                            ck(2, link) = InStr(rifrif + 1, a, p(data, 2))
                            ck(3, link) = InStr(ck(2, link), a, p(data, 3)) + p(data, 5)
                            ck(4, link) = InStr(ck(3, link), a, p(data, 4))
                            linkpb(link, data) = Mid(a, ck(3, link), ck(4, link) - ck(3, link))
                            rifrif = ck(4, link)
                           
                            If linkpb(link, data) = " " Then
                            linkpb(link, data) = ""
                            End If
                            If data = 12 Then
                            linkpb(link, data) = Format(linkpb(link, data), Standard)
                            End If
                           
                                                       
                            Sheets("prelievo").Cells(link + 8, d(data)).Value = linkpb(link, data)
                    Next data
            Next link
           
           
            '--metto i numeri e adatto la larghezza--------
    Range("CA9:CA1400").Copy
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A7").Select
   
    Rows("9:1000").Select
    Selection.RowHeight = 15
    Range("A8").Select
   
'-------------------------------------------------
        selezionate
       
   
    ActiveWindow.DisplayGridlines = False
       
        Unload userform1
       
fine = Timer1  '2
MsgBox ("Tempo impiegato " & Int((fine - inizio) / 60) & " min " & (fine - inizio) Mod 60 & " Sec")
       

End Sub
Function quanteVolte(str1, str2)
  Dim strArray
  strArray = Split(str1, str2)
  quanteVolte = UBound(strArray)
End Function

Sub selezionate()
For ckb = 6 To 65000
sel1 = Sheets("studio & info").Cells(ckb, 3).Value
If sel1 = "" Then
inizio = ckb - 1
ckb = 65000
End If
Next ckb

For i = 1 To 1000
sel = Sheets("prelievo").Cells(8 + i, 21).Value
If sel <> "" Then
For ii = 1 To 12
Sheets("studio & info").Cells(i + inizio, d(ii) + 1).Value = Sheets("prelievo").Cells(sel + 8, d(ii)).Value
Next ii
Else
i = 1000
End If
Next i
End Sub

Sub parametri()

v = 1
p(v, 2) = "tbl_black_n_"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1

End Sub
Sub Naviga(url)
a = ""
On Error Resume Next
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False
    objIE.Navigate url
    c1 = Time
    Do While objIE.busy
    DoEvents
    If Time > c1 + TimeValue("00:00:30") Then Exit Do
    Loop    'opzionale, loop se non completato
    a = objIE.document.body.innerHTML
    'Range("a1").Value = a
b = Len(a)
                    Resume
                    closeIE
If a = "" Then
closeIE
Naviga (url)
End If
If Len(a) < 2500 Then
closeIE
Application.Wait Now + TimeValue("00:01:00")
Naviga (url)
End If
End Sub
Sub closeIE()
    On Error Resume Next
    objIE.Quit
    Set objIE = Nothing
End Sub
Sub destinazioni()
d(1) = 1
d(2) = 2
d(3) = 5
d(4) = 6
d(5) = 8
d(6) = 9
d(7) = 11
d(8) = 13
d(9) = 15
d(10) = 16
d(11) = 17
d(12) = 18
End Sub

ciao

[AntonioPatella]

Ragazzi io avrei bisogno di condizionare i dati che il fgl scarica tramite dei filtri che inserisco manulamnete.
Si possono automatizzare anch'essi?

Grazie

[AntonioPatella]

ciao

grazie a gigi_ ho una macro che mi preleva dati , li mette in fgl prelievo , e mi copia solo alcune partite in fgl studio , ad ogni prelievo.

in col U9 , in giu' scrivo il numero delle partite da "studiare" e me le ritrovo gia in fgl studio.

Codice: Seleziona tutto

Option Base 1
Public objIE As Object
Public a As Variant
Public url As String
Public linkpb(500, 15) As String
Public p(12, 6) As Variant
Public ck(6, 500) As Variant
Public rif, rifrif, fine, inizio As Variant
Public d(12)


Sub estrailinkpb()

userform1.Show vbModeless
DoEvents
inizio = Timer1

myDate = Int(Now())
url = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=" & Day(myDate) _
    & "&dm=" & Month(myDate) & "&dy=" & Year(myDate) & "&df=1&dw=3"

Naviga (url)

Range("B9:R1000").ClearContents

   
parametri
destinazioni

numero = quanteVolte(a, "tbl_") / 19

            rifrif = 0
            For link = 1 To numero ' Sheets("prelievo").Cells(2, 5).Value
           
                    For data = 1 To 12
                            ck(2, link) = InStr(rifrif + 1, a, p(data, 2))
                            ck(3, link) = InStr(ck(2, link), a, p(data, 3)) + p(data, 5)
                            ck(4, link) = InStr(ck(3, link), a, p(data, 4))
                            linkpb(link, data) = Mid(a, ck(3, link), ck(4, link) - ck(3, link))
                            rifrif = ck(4, link)
                           
                            If linkpb(link, data) = " " Then
                            linkpb(link, data) = ""
                            End If
                            If data = 12 Then
                            linkpb(link, data) = Format(linkpb(link, data), Standard)
                            End If
                           
                                                       
                            Sheets("prelievo").Cells(link + 8, d(data)).Value = linkpb(link, data)
                    Next data
            Next link
           
           
            '--metto i numeri e adatto la larghezza--------
    Range("CA9:CA1400").Copy
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A7").Select
   
    Rows("9:1000").Select
    Selection.RowHeight = 15
    Range("A8").Select
   
'-------------------------------------------------
        selezionate
       
   
    ActiveWindow.DisplayGridlines = False
       
        Unload userform1
       
fine = Timer1  '2
MsgBox ("Tempo impiegato " & Int((fine - inizio) / 60) & " min " & (fine - inizio) Mod 60 & " Sec")
       

End Sub
Function quanteVolte(str1, str2)
  Dim strArray
  strArray = Split(str1, str2)
  quanteVolte = UBound(strArray)
End Function

Sub selezionate()
For ckb = 6 To 65000
sel1 = Sheets("studio & info").Cells(ckb, 3).Value
If sel1 = "" Then
inizio = ckb - 1
ckb = 65000
End If
Next ckb

For i = 1 To 1000
sel = Sheets("prelievo").Cells(8 + i, 21).Value
If sel <> "" Then
For ii = 1 To 12
Sheets("studio & info").Cells(i + inizio, d(ii) + 1).Value = Sheets("prelievo").Cells(sel + 8, d(ii)).Value
Next ii
Else
i = 1000
End If
Next i
End Sub

Sub parametri()

v = 1
p(v, 2) = "tbl_black_n_"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1

End Sub
Sub Naviga(url)
a = ""
On Error Resume Next
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False
    objIE.Navigate url
    c1 = Time
    Do While objIE.busy
    DoEvents
    If Time > c1 + TimeValue("00:00:30") Then Exit Do
    Loop    'opzionale, loop se non completato
    a = objIE.document.body.innerHTML
    'Range("a1").Value = a
b = Len(a)
                    Resume
                    closeIE
If a = "" Then
closeIE
Naviga (url)
End If
If Len(a) < 2500 Then
closeIE
Application.Wait Now + TimeValue("00:01:00")
Naviga (url)
End If
End Sub
Sub closeIE()
    On Error Resume Next
    objIE.Quit
    Set objIE = Nothing
End Sub
Sub destinazioni()
d(1) = 1
d(2) = 2
d(3) = 5
d(4) = 6
d(5) = 8
d(6) = 9
d(7) = 11
d(8) = 13
d(9) = 15
d(10) = 16
d(11) = 17
d(12) = 18
End Sub

ciao

NN ho capito dove inserire questo testo...
In macro mi da errore...

[Gigi_]

ci fai vedere il tuo file?
ti consiglio
http://www.mediafire.com

[AntonioPatella]

http://www.filedropper.com/showdownload ... cottodel30

Prova qui se va...

[AntonioPatella]

http://www.mediafire.com/view/?bwj8ltd5qz1v9lq

Adesso lo messo dove hai detto tu!!!

[AntonioPatella]

Faccio una piccola descrizione:
in allegato troverai un file excel dove in automatico effettua un refresh ogni 5 min ed estrapola alcuni dati tramite delle formuleche ho impostato io.

Il punto è il seguente, quando nn sono in casa il foglio dovrebbe automaticamente aggiornare i dati e salvargli nel foglio 2 ad esempio, conservando lo storico dei vecchi aggiornamenti...

Però non mi occorrono tutti i dati, infatti io dopo che il foglio si aggiorna vado nella colonna "Z"...applico un filtro sui segni 1 X 2 e dico: "Filtri per numeri" -> "Minori di..." inserisco "0" e do invio la stessa cosa faccio sul segno "2". Il risultato deve dare che sia sul segno "1" che sul segno "2" i valori siano negativi e il segno "X" positivi.

Dopo che effettuo questi filtri mi copio tutto da "A" a "AB" sul foglio 2 e monitoro la situazione tramite lo storico dei dati.

Questo è quello che dovrebbe fare il file in automatico...

E' possibile realizzarlo secondo te?

Ti ringrazio per la disponibilità!!!

[raimea]

ciao
hai un mp
ciao

[AntonioPatella]

raimea nn riesco a vedere l'allegato...

[AntonioPatella]

raimea nn riesco a vedere l'allegato...

raimea scusami adesso ci sono riuscito!!!

[Anthony47]

Ciao e benvenuto anche da parte mia.
Premesso che ci sono 100 modi per fare le stesse cose, volendo rimanere nella web query si potrebbe usare il suo evento AfterRefresh, tramite l' uso di un codice come questo:

Codice: Seleziona tutto

Public WithEvents qt As QueryTable

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
If Not Success Then Exit Sub
Dim LastSh2 As Long
'
LastSh2 = Sheets("Foglio2").Cells(Rows.Count, 2).End(xlUp).Row
'
With Sheets("Foglio2").Cells(LastSh2 + 3, 2)
    .Value = Now()
    .Interior.ColorIndex = 4
    .Font.Bold = True
End With
With Sheets("Foglio1")
    .Range("$Z$1:$AB$1000").AutoFilter Field:=1, Criteria1:=">=0"
    .Range("$Z$1:$AB$1000").AutoFilter Field:=3, Criteria1:=">=0"
    .Range("A2:AB1000").SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Sheets("Foglio2").Cells(LastSh2 + 4, 1)
End With
'Beep
'Foglio2.Range("AD1").Value = Foglio2.Range("AD1").Value + 1
End Sub

Private Sub Worksheet_Activate()
Set qt = Nothing
DoEvents
Set qt = Sheets("Foglio1").Range("B2").QueryTable
End Sub


Va inserito nel "Modulo di codice" di Foglio1:
-tasto dx sul tab col nome Foglio1, scegli Visualizza codice
-copia il codice e incollalo nel frame vuoto di dx; la riga Public WithEvents deve essere in testa al modulo, prima di qualsiasi istruzione.
La prima macro e' la vera gestione all' evento; prevede il filtro delle colonne Z e AB come descritto nei messaggi, poi la copia e l' accodamento a quanto gia' scritto in Foglio2

La seconda macro, Sub Worksheet_Activate, serve ad impostare l' evento e quindi avviare il processo; che quindi per essere avviato prevede che il Foglio1 divenga attivo (da non attivo); e' una scelta arbitraria, si potrebbe anche farlo nella WorkbookOpen...

Spero che possa essere di qualche utilita'.

Ciao

[AntonioPatella]

Grazie Antony e grazie a tutti gli amici del forum...
Buona Pasqua a a tutti !!!

Antonio P.