Come dichiarare Questo Foglio

Hai un problema con Excel?

Nuova discussione

Come dichiarare Questo Foglio
di Luca.Donati data: 02/10/2013 16:05:05
Di nuovo buongiorno a tutti.
Questa discussione fa seguito a quella precedente in cui mi lamentavo che For Each faceva di testa sua (h t t p : / / w w w .excelvba. it/Forum/thread.php?f=1&t=4928), ora risolta.
Sono andato avanti e adesso sto utilizzando la funzione venuta fuori da quella discussione, all'interno di una macro che controlla se un record è unico prima di copiarlo nel foglio di destinazione.
La macro listata qui sotto si chiama CopiaSeUnico e viene dopo la funzione già discussa prima, che viene richiamata al suo interno.

Ora, il problema è diventato che non riesco a dichiarare correttamente i fogli, e mi impicco tra il formato String e il formato Worksheet.
Troverete qui sotto un codice un po' confuso a causa di questa difficoltà; ho capito che in
Set fog = Sheets(fg)
la prima è una variabile di tipo Worksheet e viene valorizzata mediante una variabile "taxi" di tipo String.
Ma perché questa tecnica funziona nella Function e invece non funziona più nella macro?
E soprattutto, perché il foglio corrente (ActiveSheet) sembra così reticente a dichiarare la propria identità al mio codice?
Sono io che gli faccio paura, oppure è lui che ha la coscienza sporca?

Vi ringrazio in anticipo delle vostre osservazioni, sempre utilissime. Ciao.

Public Function QuId(fg As String, CL As Range) As Integer
Application.Volatile (True)

Dim suite1 As String, suite2 As String, Des As Range
Dim r As Long, s As Long, Sh As Worksheet, risp As Range, T As Long, i As Long
Dim a As String, b As String, c, d, e, f, a1 As String, b1 As String, c1, d1, e1, f1

r = CL.Row
a = Cells(r, 1).Value
b = Cells(r, 2).Value
c = Cells(r, 3).Value
d = Cells(r, 4).Value
e = Cells(r, 5).Value
f = Cells(r, 6).Value
suite1 = a & b & c & d & e & f


Set Sh = Sheets(fg)
i = 0
With Sh
    Set Des = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
    Set risp = Des.Find(a, LookIn:=xlValues)
    If Not risp Is Nothing Then
      s = risp.Row
      For T = s To .Cells(Rows.Count, "A").End(xlUp).Row
         a1 = .Cells(T, 1).Value
         b1 = .Cells(T, 2).Value
         c1 = .Cells(T, 3).Value
         d1 = .Cells(T, 4).Value
         e1 = .Cells(T, 5).Value
         f1 = .Cells(T, 6).Value
         suite2 = a1 & b1 & c1 & d1 & e1 & f1
           If suite1 = suite2 Then i = i + 1
       Next T
    End If
    
End With
QuId = i
Set Sh = Nothing
Set risp = Nothing
Set Des = Nothing
 
End Function
'_______________________________________________________________________
Sub CopiaSeUnico()
Dim UrA As Long, UrB As Long, i As Long
Dim fg As String, qf As String
Dim fog As Worksheet, qfog As Worksheet
fg = Range("foglio").Value
Set fog = Sheets(fg)
qfog = ActiveSheets.Name
Set qf = Sheets(qfog)
UrA = qfog.Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To UrA
If QuId(fg, Cells(i, 1)) < 1 Then
    UrB = fog.Cells(Rows.Count, 1).End(xlUp).Row
    qfog.Range(Cells(i, 1), Cells(i, 6)).Copy
    fog.Range(Cells(UrB, 1)).PasteSpecial (xlPasteValues)
End If
Next i
End Sub

di Grograman (utente non iscritto) data: 02/10/2013 16:25:00
Puoi allegare il file per favore?
di Vecchio Frac data: 02/10/2013 16:26:00
C'è in effetti qualche confusione.

cit. "e mi impicco tra il formato String e il formato Worksheet. "
---> solitamente un foglio dovrebbe essere referenziato mediante una variabile di tipo Worksheet.

Nella Function QuId accetti fg come stringa (e potrebbe / dovrebbe essere un Worksheet); poteva bastare passare fg come Worksheet e chiamarlo magari sh direttamente, avendolo già bello e pronto senza altre variabili in mezzo).

Nella Sub, a fg assegni il valore dell'intervallo denominato "foglio" (ma esiste un intervallo chiamato così?).
A cascata, chiaro che poi "fog" non contiene niente.
C'è poi un errore di ortografia (ma perchè *non* premettete mai Option Explicit in testa ai moduli?):
il foglio attivo è ActiveSheet, senza s finale:
qfog = ActiveSheets.Name
deve essere
qfog = ActiveSheet.Name

Inoltre qf è dichiarata come un valore testuale, non di tipo foglio, e la riga seguente
Set qf = Sheets(qfog)
genera errore.
di Grograman (utente non iscritto) data: 02/10/2013 16:26:37
E dichiarare le variabili visto che probabilmente è qui l'errore:
qfog = ActiveSheet.Name ''SENZA ESSE Set qf = Sheets(qfog)
di Grgoraman (utente non iscritto) data: 02/10/2013 16:27:16
Mi ha preceduto VF ^_^
Pausa!
di Luca.Donati data: 02/10/2013 16:31:00
Sì, ammetto che nella confusione ho anche invertito due variabili, quindi mi state sicuramente prendendo per scemo (e forse non avreste poi molto torto).
Quindi fermi tutti, lasciatemi mezz'ora, faccio tesoro dei consigli che mi avete appena dato e poi torno qui, mettendo anche il file.
Grazie a tutti, a fra poco.

di Luca.Donati data: 02/10/2013 16:53:33
Ho allegato il file di esempio, rimesso a posto il nome delle variabili scambiate, tolto la S (v. anche qui sotto, riporto la sola Sub).
Nella Function, fg era diventata una stringa a seguito della discussione (non ricordo esattamente, ma volendo si può andare a vedere).
L'intervallo denominato "foglio" c'è, è il nome che ho dato ad una cella e che riporta il nome del foglio con il quale voglio fare il confronto.
Option explicit era saltato durante il copia-incolla, adesso l'ho rimesso.

Resta il fatto che non funziona ancora:
- fog viene valorizzato per primo, e funziona, tanto è vero che quando il codice si blocca in variabile UrB ci trovo il valore giusto;
- per qfog seguo ESATTAMENTE lo stesso procedimento; perché si blocca? Dice: metodo Range dell'oggetto Worksheet non riuscito.

All'occasione, mi spieghereste per favore quand'è che ci vuole la S alla fine di Sheet, Cell, ecc?

Sub CopiaSeUnico()
Dim UrA As Long, UrB As Long, i As Long
Dim fg As String, qf As String
Dim fog As Worksheet, qfog As Worksheet
fg = Range("foglio").Value
Set fog = Sheets(fg)
qf = ActiveSheet.Name
Set qfog = Sheets(qf)
UrA = qfog.Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To UrA
If QuId(fg, Cells(i, 1)) < 1 Then
    UrB = fog.Cells(Rows.Count, 1).End(xlUp).Row
    qfog.Range(Cells(i, 1), Cells(i, 6)).Copy
    fog.Range(Cells(UrB, 1)).PasteSpecial (xlPasteValues) ' SI BLOCCA QUI
End If
Next i
End Sub

di Luca.Donati data: 02/10/2013 16:56:28
Piccola correzione, altrimenti mi cancella l'ultimo valore copiato...
fog.Range(Cells(UrB+1, 1)).PasteSpecial (xlPasteValues)
di Vecchio Frac data: 02/10/2013 17:41:48
Una precisazione doverosa da parte mia:
cit. "quindi mi state sicuramente prendendo per scemo"
---> assolutamente no. Qui nessuno deve prendere in giro nessuno: siamo qui per imparare *tutti* gli uni dagli altri, qualsiasi titolo abbiano in questo forum, a partire dal moderatore ^_^

Ora devo uscire ma stasera torniamo sull'argomento della discussione :)
di luca.donati (utente non iscritto) data: 02/10/2013 19:00:31
Tranquillo, Vecchio Frac, era solo una battuta. Conosco questo forum da anni e non ho mai dubitato del rispetto reciproco che vi regna.
Va detto anche che essendo un luogo di scambio, nessuno deve arrivare pensando di farsi tirare d'impiccio senza sforzo; la mia era quindi un'ammissione di confusione che mi sembrava doverosa, come per far vedere che un po' di sforzo ce lo metto.
di Vecchio Frac data: 02/10/2013 20:53:10
Togli Range dopo fog. Altrimenti devi specificare anche la seconda cella che compone il range.
fog.Cells(UrB + 1, 1).PasteSpecial xlPasteValues

di Vecchio Frac data: 02/10/2013 21:14:09
Per curiosità e divertimento aggiungo una bella funzione flatten() che appiattisce un range per colonna e che serve a unire (sfruttando Join) i valori in "suite1" e "suite2" in modo un pochino più elegante.

Public Function QuId(fg As String, CL As Range) As Integer
Dim suite1 As String, suite2 As String, Des As Range
Dim r As Long, s As Long, Sh As Worksheet, risp As Range, T As Long, i As Long
Dim a As String, b As String, c, d, e, f, a1 As String, b1 As String, c1, d1, e1, f1

    r = CL.Row

    suite1 = Join(flatten(Range(Cells(r, 1), Cells(r, 6))), "")
    
    Set Sh = Sheets(fg)
    i = 0
    With Sh
        Set Des = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        Set risp = Des.Find(a, LookIn:=xlValues)
        If Not risp Is Nothing Then
          s = risp.Row
          For T = s To .Cells(Rows.Count, "A").End(xlUp).Row
                suite2 = Join(flatten(Range(Cells(T, 1), Cells(T, 6))), "")
                If suite1 = suite2 Then i = i + 1
           Next T
        End If
        
    End With
    QuId = i
    Set Sh = Nothing
    Set risp = Nothing
    Set Des = Nothing
 
End Function

Function flatten(r As Range) As Variant
Dim i As Integer, vect() As String, v As Variant
    ReDim vect(1 To r.Count)
    For Each v In r
        i = i + 1
        vect(i) = v
    Next
    flatten = vect
End Function

di Vecchio Frac data: 02/10/2013 21:16:16
cit. "mi spieghereste per favore quand'è che ci vuole la S alla fine di Sheet, Cell, ecc?"
---> Non è questione di spiegazioni... se un oggetto o un suo attributo (proprietà) sono definiti nella classe di riferimento, devi utilizzare quel nome o quell'attributo come scritto. Altrimenti ottieni errore. Solitamente Intellisense dopo il punto ti elenca metodi e proprietà di un oggetto. Proprio al limite, premi F2 quando sei in VBE e gustati il Visualizzatore oggetti :)
di Luca.Donati data: 03/10/2013 09:55:39
Grazie, Vecchio Frac.
La questione del Range è risolta. Ma c'è ancora qualcosa che non funziona: la funzione QuId, sia nella mia versione che in quella tua con Join e Flatten, restituisce sempre 0, per cui tutte le righe vengono sistematicamente copiate da CopiaSeUnico.
Invece, nella sua forma precedente, per l'uso in cella, funzionava alla perfezione... (thread.php?f=1&t=4928).
di Vecchio Frac data: 03/10/2013 11:51:19
Il problema è evidentemente tutto in
If suite1 = suite2 Then i = i + 1
perchè è chiaro che il confronto non viene validato mai e quindi "i" non si incrementa.
Metti lì un punto di interruzione e quando sei certo che suite1 e suite2 devono essere uguali, verifica come sono state riempite le variabili (puoi anche creare due righe fittizie identiche in modo da forzare il confronto).
Se suite1, con o senza il maquillage con flatten, non è uguale a suite2, deve esserci qualcosa che impedisce alle due variabili di essere identiche.
di Luca.Donati data: 04/10/2013 12:12:40
Premetto che non sono affatto bravo col debug.
Con il metodo join è saltata la valorizzazione della variabile "a", quindi find non cercava nulla (variabile vuota). Poco male, ho riaggiunto una riga.
Ma c'è un altro problema: Sh non viene valorizzato, cioè non funziona il m=comando Set.
Quindi il successivo Find cerca nel primo foglio invece che nel secondo e trova una quantità falsata di occorrenze.
E questo non riesco a risolverlo.

di Luca.Donati data: 04/10/2013 12:18:01
Ho allegato di nuovo il file, c'è ancora un po' di confusione a causa di tutti i controlli che ho messo...
Riporto comunque il codice qui sotto.

Sub CopiaSeUnico()
Dim UrA As Long, UrB As Long, i As Long, Q As Integer
Dim fg As String, qf As String
Dim fog As Worksheet, qfog As Worksheet
Application.ScreenUpdating = False
fg = Range("foglio").Value
Set fog = Sheets(fg)
qf = ActiveSheet.Name
Set qfog = Sheets(qf)
UrA = qfog.Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To UrA
Q = QuId(fg, Cells(i, 1))
If Q < 1 Then
    UrB = fog.Cells(Rows.Count, 1).End(xlUp).Row
    MsgBox (qf & " - " & UrA & " - " & fg & " - " & UrB & " - " & Q & " - " & i) 'per controllare
    qfog.Range(Cells(i, 1), Cells(i, 6)).Copy
    fog.Cells(UrB + 1, 1).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
End If
Next i
Application.ScreenUpdating = True
End Sub

Public Function QuId(fg As String, CL As Range) As Integer
Dim suite1 As String, suite2 As String, Des As Range
Dim r As Long, s As Long, Sh As Worksheet, risp As Range, T As Long, i As Long
Dim a As String, b As String, c, d, e, f, a1 As String, b1 As String, c1, d1, e1, f1

    r = CL.Row
    a = Cells(r, 1).Value
    suite1 = Join(flatten(Range(Cells(r, 1), Cells(r, 6))), "")
    Cells(r, 11) = suite1
    Set Sh = Sheets(fg)
    i = 0
    With Sh
        Set Des = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        Set risp = Des.Find(a) ', LookIn:=xlValues)
        If Not risp Is Nothing Then
          s = risp.Row
          For T = s To .Cells(Rows.Count, "A").End(xlUp).Row
                suite2 = Join(flatten(Range(Cells(T, 1), Cells(T, 6))), "")
                If suite1 = suite2 Then i = i + 1
           Next T
        End If
        
    End With
    QuId = i
    Set Sh = Nothing
    Set risp = Nothing
    Set Des = Nothing
 
End Function

Function flatten(r As Range) As Variant
Dim i As Integer, vect() As String, v As Variant
    ReDim vect(1 To r.Count)
    For Each v In r
        i = i + 1
        vect(i) = v
    Next
    flatten = vect
End Function

Vuoi Approfondire?