[VBA+SQL] Macro in Excel con estrazione SQL

[ciopin83]

Ciao a tutti. Avrei bisogno di un aiutino con questa macro, che ho trovato su internet e ho personalizzato (anche perché sono un novizio di VBA). Dovrei fare un'estrazione da un foglio di Excel, prendendo tutte le voci non duplicate di una colonna; questa è la macro che ho al momento, ma mi dà errore alla riga "objRs.Open sql, objConn, 3, 3, 1"; appena creata, avevo provato a far girare la macro in un foglio nuovo e funzionava, tranne se cambiavo la riga fldDate = "Data" modificando il numero di caratteri tra virgolette (es. se anziché Data scrivevo anche solo Datas, mi dava errore e si bloccava nello stesso punto). Ecco l'errore che mi restituisce:

Errore di run-time '-2147217900 (80040e14)':
L'istruzione SELECT include una parola riservata o un argomento scritto in modo errato o mancante oppure la punteggiatura non è corretta

Sub raggruppa()
Dim objConn
Dim objRs
Dim shToGroup As String
Dim shDestination As String
Dim fldDate As String
Dim wrk As Workbook
Dim cont As Long
Set wrk = ThisWorkbook
shToGroup = "Foglio1"
shDestination = "Foglio2" 'Foglio di destinazione
fldDate = "Data"
Dim sql As String
sql = "SELECT distinct [" & fldDate & "] As DATE, count(*) As CONTATORE FROM [" & shToGroup & "$] group by DATE order by DATE"
Set objConn = CreateObject("ADODB.Connection")
objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & wrk.FullName & ";Extended Properties=Excel 8.0;"
Set objRs = CreateObject("ADODB.Recordset")
objRs.Open sql, objConn, 3, 3, 1
cont = 0
Do Until objRs.EOF
cont = cont + 1
Sheets(shDestination).Cells(cont, 1) = objRs.Fields("DATE").Value
Sheets(shDestination).Cells(cont, 2) = objRs.Fields("CONTATORE").Value
objRs.MoveNext
Loop
MsgBox "Raggruppamento eseguito nel foglio '" & shDestination & "' !"
End Sub

[MarcoGG]

Originariamente inviato da ciopin83

...
Dim wrk As Workbook
Dim cont As Long
Set wrk = ThisWorkbook
...

Prima di capire cosa vada storto, c'è una ragione particolare nell'usare ADO per leggere dati dallo stesso Workbook ?
ADO lo si usa soprattutto per leggere da Books esterni senza doverli aprire ( e non è l'unico metodo, tra l'altro... ).

[ciopin83]

Originariamente inviato da MarcoGG

Prima di capire cosa vada storto, c'è una ragione particolare nell'usare ADO per leggere dati dallo stesso Workbook ?
ADO lo si usa soprattutto per leggere da Books esterni senza doverli aprire ( e non è l'unico metodo, tra l'altro... ).

Sto muovendo i primi passi in VBA e, quando mi è stato chiesto se era possibile creare una macro che estraesse dati non duplicati, mi è venuto in mente il select distinct in sql; ho trovato una macro in vba che faceva una cosa simile e l'ho leggermente personalizzata... quindi, no, non c'è una ragione particolare o meglio la ragione è che non avrei saputo cos'altro fare, ma se ci sono alternative più semplici, ben vengano!

[MarcoGG]

Originariamente inviato da ciopin83

Sto muovendo i primi passi in VBA e, quando mi è stato chiesto se era possibile creare una macro che estraesse dati non duplicati, mi è venuto in mente il select distinct in sql; ho trovato una macro in vba che faceva una cosa simile e l'ho leggermente personalizzata... quindi, no, non c'è una ragione particolare o meglio la ragione è che non avrei saputo cos'altro fare, ma se ci sono alternative più semplici, ben vengano!

Metodi ce ne sono a bizzeffe, comincio col consigliarti questo, che secondo me è abbastanza compatto e sicuramente flessibile in quanto carica in un array ( che poi si può leggere e usare come si vuole ) tutti i valori presenti in un dato Range di celle ( nel mio esempio, la colonna A, da 1 a 10 ), e senza duplicati :

    Dim arrayValori() As Variant
    Dim AllCells As Range
    Dim Cell As Range
    Dim NoDupes As New Collection
    Dim i As Long
    i = 0
    Dim Item As Variant
    Set AllCells = Sheets("Foglio1").Range("A1:A10")
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    Dim cnt As Long
    cnt = 0
    For Each Item In NoDupes
        ReDim Preserve arrayValori(cnt)
        arrayValori(cnt) = Item
        cnt = cnt + 1
    Next Item
   
    For i = 0 To UBound(arrayValori)
        MsgBox arrayValori(i)
    Next i

Prova...

[ciopin83]

Ottimo! Funge. Grazie mille. Nei prossimi giorni vedo di fare qualche piccola modifica e ti faccio sapere se ci sono riuscito; il "grosso" sarà fare un ciclo for che partendo dalla prima riga dei dati, vada avanti fino alla prima cella vuota della colonna

[MarcoGG]

Originariamente inviato da ciopin83

Ottimo! Funge. Grazie mille. Nei prossimi giorni vedo di fare qualche piccola modifica e ti faccio sapere se ci sono riuscito; il "grosso" sarà fare un ciclo for che partendo dalla prima riga dei dati, vada avanti fino alla prima cella vuota della colonna

Eh eh, il "grosso" ?
No, il "grosso" sono 2 righe di codice. E così per la colonna A senza dover sapere dove finisce il Range :

    Dim indiceUltima As Long
    indiceUltima = Range("A65536").End(xlUp).Row

    Dim arrayValori() As Variant
    Dim AllCells As Range
    Dim Cell As Range
    Dim NoDupes As New Collection
    Dim i As Long
    i = 0
    Dim Item As Variant
    Set AllCells = Sheets("Foglio1").Range("A1:A" & indiceUltima)
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    Dim cnt As Long
    cnt = 0
    For Each Item In NoDupes
        ReDim Preserve arrayValori(cnt)
        arrayValori(cnt) = Item
        cnt = cnt + 1
    Next Item

    For i = 0 To UBound(arrayValori)
        MsgBox arrayValori(i)
    Next i

[ciopin83]

Dicevo "grosso" per dire... beh, più o meno; mi sto impigrendo con queste vacanze
Io pensavo a un ciclo do until con condizione cell<>""; sono circa 800 righe. Secondo te può andare bene come soluzione? Escluderei l'InputBox, che ho usato in un'altra situazione.

[MarcoGG]

Originariamente inviato da ciopin83

Io pensavo a un ciclo do until con condizione cell<>""; sono circa 800 righe. Secondo te può andare bene come soluzione? Escluderei l'InputBox, che ho usato in un'altra situazione.

No, ma usa appunto le due righe che ho suggerito :

    Dim indiceUltima As Long
    indiceUltima = Range("A65536").End(xlUp).Row

indiceUltima ti ritorna proprio l'indice di riga dell'ultima cella non-vuota.

Se invece usi Excel 2007, non hai più il limite di 65536 righe, ma potresti avere un indiceUltima = Range("A1000000").End(xlUp).Row !

[ciopin83]

Originariamente inviato da MarcoGG

No, ma usa appunto le due righe che ho suggerito :

    Dim indiceUltima As Long
    indiceUltima = Range("A65536").End(xlUp).Row

indiceUltima ti ritorna proprio l'indice di riga dell'ultima cella non-vuota.

Se invece usi Excel 2007, non hai più il limite di 65536 righe, ma potresti avere un indiceUltima = Range("A1000000").End(xlUp).Row !

A1000000! Peccato che non usi ancora il 2007, altrimenti già mi immaginavo il capo a bestemmiare per il pc impallato!