ciclo do error runtime 1004 applicazione o oggetto

Hai un problema con Excel?

Nuova discussione

ciclo do error runtime 1004 applicazione o oggetto
di delion85 (utente non iscritto) data: 19/05/2016 03:44:29
Ciao a tutti.
Premetto che non sono una cima con il vba, ma ce la metto tutta.
sto scrivendo una macro in vba con l'obbiettivo di importare su excel su un foglio1 una serie di tabelle contenenti dati, provenienti da una lista discontinua di link presenti su un foglio2 che ahimè devo mantenere discontinua, nel senso che alcune celle sono vuote all'interno della lista stessa.
credevo di aver fatto tutto abbastanza bene, ma quando dico alla macro di "saltare" le celle vuote e importare quelle contenenti i link, esegue tutta la macro e poi a fine macro si blocca e mi restituisce errore 1004 definito dall'applicazione o dall'oggetto alla riga "Loop Until Len(Sheets(fglink).Cells(i, 14)) <> 0"
mi date qualche dritta per correggere o evitare l'errore ??
grazie!!

Sub importdata()
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
cdest = 1
i = 4
    Do While i < 310
        If Len(Sheets(fglink).Cells(i, 14)) = 0 Then
            Do
                i = i + 1
            Loop Until Len(Sheets(fglink).Cells(i, 14)) <> 0
        Else
        Sheets(fgimport).Cells(rdest - 1, cdest) = Sheets(fglink).Cells(i, 2)
        With Sheets(fgimport).QueryTables.Add(Connection:= _
            "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
            Sheets(fgimport).Cells(rdest, cdest))
            .PostText = "local"
            .Name = False
            .FieldNames = False
            .RefreshStyle = xlInsertDeleteCells
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .HasAutoFormat = True
            .RefreshOnFileOpen = 1
            .BackgroundQuery = False
            .TablesOnlyFromHTML = True
            .SaveData = True
            .Refresh BackgroundQuery:=False
            .UseListObject = False
        End With
        rdest = rdest + 20
        End If
        i = i + 1
    Loop
End Sub

di Raffaele_53 data: 19/05/2016 05:26:09
Credo che devi allegare un file + spiegzioni (forse non sono in grado)
EDIT anzi sicuramente se usi un "mac"
di Raffaele_53 (utente non iscritto) data: 19/05/2016 12:52:58
il fatto che uso un mac cambia poco, il codice sarebbe praticamente lo stesso...
di delion85 (utente non iscritto) data: 19/05/2016 12:55:10
file allegato
di Raffaele_53 data: 19/05/2016 13:17:04
Vedi Tu, tutte le macro che funzionano con Windows e non in Mac

Per adesso ho notato solo che in formule/gestione nomi ci sono tanti #Rif e non capisco bene il tuo VBA

Il post >>>di Raffaele_53 (Utente non iscritto) data: 19/05/2016 12:52:58 non è mio. Dato che sono registrato
di patel data: 19/05/2016 15:10:48
prova a eliminare
.UseListObject = False

di delion85 (utente non iscritto) data: 19/05/2016 20:14:11
nomi non ne sto usando e sono residui di un precedente file, ma li cancello tutti per levare ogni dubbio.
provo a rispiegarmi e a rincollare il codice a cui ho apportato un paio di modifiche ed ora mi sposta l'errore associandolo ad una variabile.
ho due fogli: uno contiene una serie di link che vengono costruiti in base a una serie di dati. i link funzionano correttamente e sono già stati verificati. il secondo foglio deve contenere le tabelle di dati che voglio che excel (vba) mi importi dai link che sono sull'altro foglio. voglio che me li importi tutti e che li inserisca in posizioni predefinite (e questo lo fa correttamente). l'errore nasce dal fatto che nella lista dei link, sono presenti anche link che non vengono creati, e quindi il valore della cella è "". voglio che il vba mi riconosca quando compare una cella con valore "", salta alla successiva e se è presente il link (semplicemente, la cella non ha valore "") importa la tabella, altrimenti continua a saltare alla successiva finché non incontra una cella con dentro il link. il tutto finché non finisce la lista dei link.
la freccia indica la riga di codice che mi evidenzia il debug.

Sub importdata()
Dim valcella As String
Dim lunghcella As Integer
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
cdest = 1
salti = 0
i = 4
    Do While i < 315
        valcella = Sheets(fglink).Cells(i, 14).Value
        lunghcella = Len(valcella)
        If lunghcella = 0 Then
            Do While lunghcella = 0
                i = i + 1
---->>> valcella = Sheets(fglink).Cells(i, 14).Value <<<----
                lunghcella = Len(valcella)
                salti = salti + 1
            Loop
        End If
        Sheets(fgimport).Cells(rdest - 1, cdest) = Sheets(fglink).Cells(i, 2)
        With Sheets(fgimport).QueryTables.Add(Connection:= _
            "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
            Sheets(fgimport).Cells(rdest, cdest))
            .PostText = "local"
            .Name = False
            .FieldNames = False
            .RefreshStyle = xlInsertDeleteCells
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .HasAutoFormat = True
            .RefreshOnFileOpen = 1
            .BackgroundQuery = False
            .TablesOnlyFromHTML = True
            .SaveData = True
            .Refresh BackgroundQuery:=False
            .UseListObject = False
        End With
        rdest = rdest + 20
        i = i + 1
        valcella = Sheets(fglink).Cells(i, 14).Value
        lunghcella = Len(valcella)
    Loop
    MsgBox salti
End Sub

di delion85 (utente non iscritto) data: 19/05/2016 20:16:45
ho inserito il nuovo file senza nomi

di Raffaele_53 data: 19/05/2016 21:18:26
Non conosco bene il 'Do While i < 25
Uso sempre fare cicli For ed alcuni codici faccio fatica a mettere mano. Sub prova per farti capire, il resto "penso" vada bene

Sub prova()
Dim X, fglink
fglink = Worksheets(2).Name
    For X = 4 To 25
        valcella = Sheets(fglink).Cells(X, 14).Value
        If valcella <> "" Then
          MsgBox "cella piena, eseguo codice "
        Else
            MsgBox "cella vuota"
        End If
    Next X
End Sub

Sub importdata()
Dim valcella As String
Dim lunghcella, X
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
cdest = 1
salti = 0
i = 4
    Do While i < 315
        valcella = Sheets(fglink).Cells(i, 14).Value
        If valcella = "" Then
            salti = salti + 1
        Else
        Sheets(fgimport).Cells(rdest - 1, cdest) = Sheets(fglink).Cells(i, 2)
        With Sheets(fgimport).QueryTables.Add(Connection:= _
            "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
            Sheets(fgimport).Cells(rdest, cdest))
            .PostText = "local"
            .Name = False
            .FieldNames = False
            .RefreshStyle = xlInsertDeleteCells
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .HasAutoFormat = True
            .RefreshOnFileOpen = 1
            .BackgroundQuery = False
            .TablesOnlyFromHTML = True
            .SaveData = True
            .Refresh BackgroundQuery:=False
            .UseListObject = False
        End With
        End If
        rdest = rdest + 20
        i = i + 1
        'valcella = Sheets(fglink).Cells(i, 14).Value
        'lunghcella = Len(valcella)
    Loop
    MsgBox salti
End Sub

di delion85 (utente non iscritto) data: 19/05/2016 21:35:21
ok nuovo problema....ho provato a ridurre i massimo nel ciclo do-while da 310 a 30 per fare un test più veloce, ed ha funzionato senza nessun errore.
ho rimesso 310 e mi da di nuovo errore.... forse questa informazione può aiutare voi "medici del vba" a trovare la malattia di cui soffre la mia macro!!!

aiutoooooo!!!!

incollo nuovamente il codice qui sotto...

ps grazie per il suggerimento di levare .uselistobject ma purtroppo non mi elimina l'errore....

Sub prova2()
Dim valcella As String
Dim lunghcella As Integer
Dim i, rdest As Integer
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
i = 4
valcella = Sheets(fglink).Cells(i, 14).Value
lunghcella = Len(valcella)
    Do While i < 310
        If lunghcella = 0 Then
            Do While lunghcella = 0
                i = i + 1
                valcella = Sheets(fglink).Cells(i, 14).Value
                lunghcella = Len(valcella)
            Loop
        End If
        Sheets(fgimport).Cells(rdest - 1, 1) = Sheets(fglink).Cells(i, 2)
        With Sheets(fgimport).QueryTables.Add(Connection:= _
            "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
            Sheets(fgimport).Cells(rdest, 1))
            .PostText = "local"
            .Name = False
            .FieldNames = False
            .RefreshStyle = xlInsertDeleteCells
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .RefreshOnFileOpen = False
            .TablesOnlyFromHTML = True
            .SaveData = True
            .Refresh BackgroundQuery:=False
        End With
        rdest = rdest + 20
        i = i + 1
        valcella = Sheets(fglink).Cells(i, 14).Value
        lunghcella = Len(valcella)
    Loop
    MsgBox "finito"
End Sub

di Raffaele_53 data: 19/05/2016 22:49:19
Va in errore perchè è arrivato alla riga 1048576 e non esiste la cella 1048577
Il Do While i < 315 non va bene, usa il mio

Sub importdata()
Dim valcella As String
Dim lunghcella, X
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
cdest = 1
salti = 0
    For i = 4 To 315
        valcella = Sheets(fglink).Cells(i, 14).Value
        If valcella = "" Then
            salti = salti + 1
        Else
        Sheets(fgimport).Cells(rdest - 1, cdest) = Sheets(fglink).Cells(i, 2)
        With Sheets(fgimport).QueryTables.Add(Connection:= _
            "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
            Sheets(fgimport).Cells(rdest, cdest))
            .PostText = "local"
            .Name = False
            .FieldNames = False
            .RefreshStyle = xlInsertDeleteCells
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .HasAutoFormat = True
            .RefreshOnFileOpen = 1
            .BackgroundQuery = False
            .TablesOnlyFromHTML = True
            .SaveData = True
            .Refresh BackgroundQuery:=False
        End With
        End If
        rdest = rdest + 20
    Next
    MsgBox salti
End Sub

di delion85 (utente non iscritto) data: 20/05/2016 00:30:56
Grazie del suggerimento raffaele. però vedo che hai omesso il do while interno, che permetteva alla macro di "saltare" le celle vuote. Posso sapere il perché? così facendo andrebbe a elaborare tutta la lista di link, comprendente anche le celle vuote. il mio scopo è invece fargli saltare in automatico le celle vuote....
di Raffaele_53 data: 20/05/2016 00:35:28
Lo fa già di saltare e il msgbox mi dice 120 celle vuote
If valcella = "" Then salti = salti + 1 Else
di delion85 (utente non iscritto) data: 20/05/2016 00:46:23
ma così facendo non vai a modificare la i, che è l'indice che lavora dalla riga 4 alla riga 310, ovvero dove sta la lista....
di delion85 (utente non iscritto) data: 20/05/2016 00:49:37
la variabile salti che ho inserito era solo per farmi dare il numero di salti per curiosità.... ho provato ora con il ciclo for e purtroppo mi da ancora lo stesso errore, sempre sulla riga interna al do while interno....che palle.....
di Raffaele_53 data: 20/05/2016 01:00:39
Non so cosa hai fatto, a me funziona

>>>ma così facendo non vai a modificare la i
Vedi che cambia da solo eseguendo tutte le righe da 4 sino 315 (tranne le celle dove la formula da come risultato = "").

di delion85 (utente non iscritto) data: 20/05/2016 01:05:44
è vero, non avevo notato che hai inglobato l'inserimento della querytable all'interno dell'if, quindi bypassa le celle vuote senza troppi problemi...a questo punto inutile anche contare i salti.... posto codice definitivo e chiudo
grazie!!!

Sub importdata()
Dim valcella As String
Dim rdest As Integer
Dim fglink, fgimport As String
fglink = Worksheets(2).Name
fgimport = Worksheets(1).Name
rdest = 2
    For i = 4 To 310
        valcella = Sheets(fglink).Cells(i, 14).Value
        If valcella <> "" Then
            Sheets(fgimport).Cells(rdest - 1, 1) = Sheets(fglink).Cells(i, 2)
            With Sheets(fgimport).QueryTables.Add(Connection:= _
                "URL;" & Sheets(fglink).Cells(i, 14), Destination:= _
                Sheets(fgimport).Cells(rdest, 1))
                .PostText = "local"
                .Name = False
                .FieldNames = False
                .RefreshStyle = xlInsertDeleteCells
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .RefreshOnFileOpen = False
                .TablesOnlyFromHTML = True
                .SaveData = True
                .Refresh BackgroundQuery:=False
            End With
            rdest = rdest + 20
        End If
    Next
    MsgBox "finito"
End Sub

Vuoi Approfondire?