[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]

...
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]

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! :D

[MarcoGG]

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! :D

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]

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" ? :D
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

:cool: ;)

[ciopin83]

Dicevo "grosso" per dire... beh, più o meno; mi sto impigrendo con queste vacanze :p
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]

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.


:D
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 ! :eek:

[ciopin83]

:D
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 ! :eek:

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