Problema estrazione valore commento

Hai un problema con Excel?

Nuova discussione

Problema estrazione valore commento
di Luca (utente non iscritto) data: 10/12/2013 12:54:32
Salve,
Devo estrarre il commento presente in una cella, memorizzarlo in una variabile e poi scriverlo in un'altra cella.

La cosa di per sè sono riuscito a realizzarla con il codice postato sotto.

Il problema è che NON funziona se la cella fa parte di un gruppo di celle "formattate come tabella". In quel caso mi da errore runtime 91 Variabile oggetto o variabile del blocco with non impostata.

Ho provato a fare modifiche al codice, come definire n come stringa, usare il comando set etc, ma non ottengo altro che diversi errori.
Si può risolvere? :(

Grazie in anticipo!

Sub commento()
 Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
 Dim aCell As Range
 Set aCell = sh1.Range("B41")
 n = WorksheetFunction.Clean(aCell.Comment.Text)
 sh1.Range("Z100").Value = n
End Sub

di totygno71 data: 10/12/2013 13:54:08
In che senso formattato come tabella?
di Luca (utente non iscritto) data: 10/12/2013 15:54:36
ciao,
intendo proprio l'utilizzo del pulsante "formatta come tabella" presente nel menù home di excel 2010 (ma sicuramente anche negli altri).

di Grograman data: 10/12/2013 18:51:14
cit: "NON funziona se la cella fa parte di un gruppo di celle "formattate come tabella". "

Queste sono affermazioni false e tendenziose!

Option Explicit

Sub Tabbbbbella()
Dim oCmt As Comment
Dim oTbl As ListObject
Dim ws As Worksheet
Dim strCmt As String
Dim Cella As Range
  Set ws = ActiveSheet
  With ws
    Set oTbl = .ListObjects("Tabella1")
    For Each Cella In oTbl.Range
      Set oCmt = Cella.Comment
      If Not oCmt Is Nothing Then
        strCmt = oCmt.Text
        Debug.Print strCmt; oCmt.Parent.Address
      End If
      Set oCmt = Nothing
    Next Cella
    Set oTbl = Nothing
  End With
  Set ws = Nothing
End Sub

di Luca (utente non iscritto) data: 11/12/2013 10:48:33
Credo di essere stato frainteso :D

Quando dicevo che non funzionava se la cella fa parte di un gruppo di celle "formattate come tabella" parlavo del mio codice. Se fossi stato sicuro che non funzionava in generale, non avrei postato: infatti ho chiesto come si poteva risolvere, e tu gentilmente mi hai risposto :D

Me lo devo studiare un po' grazie ancora :D

di Grograman (utente non iscritto) data: 11/12/2013 10:56:05
A sto punto, visto che siamo in tema commenti, lo commento!

Option Explicit

Sub Tabbbbbella()
Dim oCmt As Comment 'variabile oggetto di tipo commento
Dim oTbl As ListObject 'variabile oggetto di tipo tabella
Dim ws As Worksheet 'variabile oggetto di tipo "foglio di lavoro"
Dim strCmt As String 'variabile di tipo stringa
Dim Cella As Range 'variabile di tipo range
  Set ws = ActiveSheet 'mera abitudine, istanzio oggetto ws il foglio attivo
  With ws
    Set oTbl = .ListObjects("Tabella1") 'poco duttile, ma con 1 tabella con quel nome istanzio la variabile sulla tabella
    For Each Cella In oTbl.Range 'per ogni cella nel range della tabella
      Set oCmt = Cella.Comment 'istanzio la variabile oCmt come il commento della cella
      If Not oCmt Is Nothing Then 'se non è nulla, cioè se esiste il commento per quella cella
        strCmt = oCmt.Text 'la variabile stringa diventa il testo del commento
        Debug.Print strCmt; oCmt.Parent.Address
      End If
      Set oCmt = Nothing 'distruggo variabile oggetto
    Next Cella
    Set oTbl = Nothing 'distruggo
  End With
  Set ws = Nothing 'distruggo
End Sub

di nichicanta (utente non iscritto) data: 11/12/2013 11:08:30
Grazie Grograman, Vi chiedo gentilmente (per noi meno esperti di VBA) di commentare i vostri preziosi codici al fine migliorare le notre conoscenze e capacità di programmare VBA con criterio e logica.
Era una segnalazione che avrei dovuto fare nella discussione"PREGI E DIFETTI DI QUESTO FORUM", solo ed esclusivamente perchè sono affascinato da questo bellissimo forum e dai suoi componenti e frequentatori (amministratore, moderatore, esperti e utenti vari) e desidero apprendere tanto e nel minor tempo possibile grazie al vostro eccellente ed encomiabile lavoro.
Buona giornata a tutti.
di Grograman (utente non iscritto) data: 11/12/2013 11:10:46
Purtroppo spesso non è una mancanza di volontà quanto una mancanza di tempo.

Ci vuole molto di più a commentare per bene un codice che a scriverlo come si deve

Ma devo dire che in linea generale il commento non è uno dei miei punti forte.
Ultimamente lo sto facendo un pò meglio perchè mi rendevo conto che a distanza di un paio di mesi faticavo io stesso a raccapezzarmi dentro codice scritto di mio pugno
di nichicanta (utente non iscritto) data: 11/12/2013 11:27:51
Gro, ormai è risaputo che il vostro impegno e prezioso lavoro( con o senza commenti al codice) è testimoniato e apprezzato dal numero elevato di utenti che ricorrono a questo forum per richieste di aiuto, di varia natura.
Al riguardo, chiedo a voi esperti ( in fase iniziale di richieste di aiuto dei nostri amici del forum e per quei casi che lo ritenete opportuno) di indicare i passaggi e/o punti di partenza ( in modo che ognuno di noi inizi con ricerche nel forum o altrove, magari già con le proprie conoscenze, ad impostare di proprio pugno il codice VBA, magari da sottopporre a voi per il miglioramento o la modifica) per la soluzione del quesito postato.
L'ho notato fare da alcuni esperti del forum in precedenti discussioni ( vedi Totygno71, Patel ecc).
Parere strettamente personale: lo ritengo molto utile per chi come, ha iniziatio, insieme a voi, a muovere i primi passi con vba.
L'augurio di una buona giornata a tutti quanti.
di patel data: 11/12/2013 18:27:07
il problema è che la maggior parte degli utenti che chiedono aiuto al forum non hanno alcuna intenzione di imparare, ma vogliono soltanto risolvere un problema, quindi per non perdere tempo conviene fornire la soluzione e poi eventualmente su richiesta commentarla.

di Luca (utente non iscritto) data: 12/12/2013 17:33:04
Salve,
allora ho cercato di isolare le istruzioni che servivano a me, considerando che per ora vorrei operare solo su una singola cella e non su una intera tabella.

Ho scritto prima il codice1, che però aveva un funzionamento identico a quello che avevo postato in precedenza (funziona solo su celle non facenti parte di tabelle). Mi sono quindi detto che l'aggiunta di una variabile commento non era sufficiente, e che quindi bisogna considerare pure la tabella.

Ho scritto allora il codice2. Se lo eseguo mi da "errore runtime 9 Indice non incluso nell'intervallo". Non so bene a cosa sia dovuto, ma a me viene in mente che la tabella in oggetto non si chiami "Tabella1". Se è come per i grafici, in cui ogni volta che excel crea un oggetto da un valore progressivo, io ora il nome della tabella non lo ritrovo più!!
Come posso fare? :(

'codice 1
Sub commento() 
 Dim aCell As Range
 Dim n As String
 Dim oCmt As Comment
  
  Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
  Set aCell = sh1.Range("B41")
  Set oCmt = aCell.Comment
  n = oCmt.Text
  sh1.Range("Z100").Value = n
End Sub

'codice 2
Sub commento()
 
 Dim oTbl As ListObject
 Dim aCell As Range
 Dim n As String
 Dim oCmt As Comment
  
  Set oTbl = Worksheets("rendimento").ListObjects("Tabella1")
  Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
  Set aCell = sh1.Range("B41")
  Set oCmt = aCell.Comment
  n = oCmt.Text
  sh1.Range("Z100").Value = n
End Sub

di Grograman data: 13/12/2013 08:59:03
Keep calm and comment on!
Niente panico!

Intanto dichiara quel foglio tra le variabili! Usate Option Explicit mannaggia a voi!

La tabella in cui cerchi sai come individuarla?
Ovvero, conosci almenoun campo della stessa?

A seguire un codice che, indipendentemente dalla tabella, se il primo campo si chiama "ILVALOREDELLAPRIMACELLADELLATABELLA" allora la da per buona e inizia la ricerca dei commenti.
(ah, ho modificato in rCell la variabile di tipo range per mera abitudine)

Option Explicit
Sub commento()
  Dim oTbl As ListObject
  Dim rCell As Range
  Dim n As String
  Dim oCmt As Comment
  Dim sh1 As Worksheet

  Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
  
  For Each oTbl In sh1.ListObjects 'CERCA IN TUTTE LE TABELLE DEL FOGLIO
    If oTbl.Range(1, 1) = "ILVALOREDELLAPRIMrCellADELLATABELLA" Then 'CERCHI UN DETERMINATO VALORE
    'If oTbl.Name = "Tabella3" Then 'ALTERNATIVA SAPENDO IL NOME DELLA TABELLA
      Set oTbl = oTbl 'SE LA TROVO ISTANZIO LA TABELLA
      Exit For 'ESCO DAL CICLO
    End If
  Next oTbl
  
  If Not oTbl Is Nothing Then 'SE HO TROVATO LA TABELLA
    For Each rCell In oTbl.Range  'CERCO IN TUTTE LE SUE CELLE
      Set oCmt = rCell.Comment 'ISTANZIO COMMENTO
      If Not oCmt Is Nothing Then 'SE ESISTE IL COMMENTO
        n = oCmt.Text 'VALORIZZO VARIABILE
        Debug.Print n 'QUI USALO COME TI SERVE
      End If
      Set oCmt = Nothing 'DISTURGGO COMMENTO O ME LO TRASCINO AL CICLO SUCCESSIVO
    Next rCell
  End If
  'sh1.Range("Z100").Value = n
  Set sh1 = Nothing
End Sub

di Grograman data: 13/12/2013 09:00:34
Ovviamente "ILVALOREDELLAPRIMrCellADELLATABELLA" è "ILVALOREDELLAPRIMACELLADELLATABELLA"....

Ecco il maledetto torva e sostituisci che ti frega come sempre...
di paolomath data: 13/12/2013 09:07:07
"torva" ?!?

Anche il T9

di Luca (utente non iscritto) data: 13/12/2013 11:49:41
@Grograman

Option Explicit non lo uso perchè non so a cosa serve :( Come è correlato a Dim sh1 As Worksheet?

In ogni caso, il tuo utilissimo codice mi ha dato uno spunto per risolvere il mio problemino. Dato che il nome della tabella sarà (spero) sempre lo stesso, mi sono scritto due righe di codice per trovarlo, e poi l'ho sostituito nel codice che ho scritto in qualche post fa. Sembra funzioni! :D

La cosa strana che ho notato, è che è sufficiente mettere come nome tabella un nome qualsiasi di tabella esistente. Mi spiego, in quel foglio io ho Tabella2 e Tabella11. Se voglio operare se una cella di tabella11, posso comunque mettere tabella2 e la cella la trova uguale...Vi torna?

Il codice che ho usato era questo, praticamente una "selezione" del tuo :D:

Option Explicit

Sub trova_nome_tabella()
  Dim oTbl As ListObject
  Dim rCell As Range
  Dim n As String
  Dim oCmt As Comment
  Dim sh1 As Worksheet
 
  Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
   
  For Each oTbl In sh1.ListObjects 'CERCA IN TUTTE LE TABELLE DEL FOGLIO
    If oTbl.Range(1, 11) = "plus/minus spesa" Then 'CERCHI UN DETERMINATO VALORE
      n = oTbl.Name
      Exit For 'ESCO DAL CICLO
    End If
  Next oTbl
   
  sh1.Range("Z100").Value = n
   
End Sub

di Luca (utente non iscritto) data: 13/12/2013 17:17:26
Ovviamente provi ad applicare quel codice alla tua macro di partenza, e non funziona più :(
Mi da un problema quando pongo la variabile n pari al testo del commento.

Mi da errore proprio su n = oCmt1.Text, con
Set oCmt1 = aCell.Comment e
Dim n As String

Esattamente come nel codice già postato e funzionante!

Ho fatto molte prove ma ogni volta è un errore diverso :(

Per esempio, con:
Set oCmt1 = aCell.Comment
n = oCmt1.Text
mi dice variabile oggetto o variabile del blocco with non impostata, riferendosi alla riga con n.

Se invece scrivo:
Set oCmt1 = aCell.Comment
Set n = oCmt1.Text
mi dice: errore di compilazione, necessario oggetto.

Non capisco...se metto semplicemente n=1, va tutto alla perfezione (ma il codice non fa quello che deve fare).

Non so se è una buona idea postare il codice completo....è molto lungo, ma la parte che ci interessa è solo l'inizio, fino alle prime righe dentro il for..

Sub flussi_di_cassa()

 Dim oTbl As ListObject
 Dim oCmt1 As Comment
 Dim oCmt2 As Comment
 Dim oneRange As Range
 Dim aCell As Range
 Dim n As String
 
 Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
 Set sh2 = Workbooks("CC.xlsm").Worksheets("flussi di cassa--cedole")
 Set SourceRange = sh2.Range("K19")
 
 Set oTbl = Worksheets("rendimento").ListObjects("Tabella11")
 'definisco il range delle date
 UltimaRigafoglio1 = sh1.Range("D65536").End(xlUp).Row
 Set oneRange = sh1.Range("D28:D" & UltimaRigafoglio1)
 Set aCell = sh1.Range("D28")
 
 'seleziono il mese attuale
 mese = Month(sh1.Range("B4"))

 'seleziono la prima cella in cui deve copiare delle date (anche questo deve essere variabile)
 Sheets("flussi di cassa--cedole").Activate
 sh2.Range("K19").Select

For Each aCell In oneRange
  
 Set oCmt1 = aCell.Comment
 Set oCmt2 = aCell.Offset(0, 2).Comment 'tassazione
 'n = WorksheetFunction.Clean(aCell.Comment.Text) 'numero di cedole: funziona solo se la cella non fa parte di una tabella
 Set n = oCmt1.Text
 'n = 1
 attivo = aCell.Offset(0, 1).Value 'bond attivo o no
  
 If (attivo = "si") Then
  If (n = 1) Then
   'grandezze di interesse
   anno = IIf(Month(aCell) > mese, 2013, 2014)
   nuovadata = DateSerial(anno, Month(aCell), Day(aCell))
   A = aCell.Offset(0, -3).Value
   B = aCell.Offset(0, 2).Value
   
   ActiveCell.Value = nuovadata
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B)
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
  
  ElseIf (n = 2) Then
   'dichiaro le variabili di interesse
   anno = IIf(Month(aCell) > mese, 2013, 2014)
   nuovadata = DateSerial(anno, Month(aCell), Day(aCell))
   oggi = Date
   nuovo_mese = Month(aCell) - 6
   altro_flusso = DateSerial(anno, nuovo_mese, Day(aCell))
     
     'calcolo la data dell'altro flusso
     If (altro_flusso < oggi) Then
     nuovo_mese = Month(aCell) + 6
     altro_flusso = DateSerial(anno, nuovo_mese, Day(aCell))
     End If
   
   A = aCell.Offset(0, -3).Value
   B = aCell.Offset(0, 2).Value
   
   ActiveCell.Value = nuovadata
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = altro_flusso
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   
  ElseIf (n = 3) Then
   anno = IIf(Month(aCell) > mese, 2013, 2014)
   nuovadata = DateSerial(anno, Month(aCell), Day(aCell))
   oggi = Date
   mese1 = Month(aCell) - 4
   flusso1 = DateSerial(anno, mese1, Day(aCell))
   mese2 = Month(aCell) - 8
   flusso2 = DateSerial(anno, mese2, Day(aCell))
   
    If flusso1 < oggi And flusso2 < oggi Then
    mese1 = Month(aCell) + 4
    flusso1 = DateSerial(anno, mese1, Day(aCell))
    mese2 = Month(aCell) + 8
    flusso2 = DateSerial(anno, mese2, Day(aCell))
    ElseIf flusso1 > oggi And flusso2 < oggi Then
    mese2 = mese1 + 8
    flusso2 = DateSerial(anno, mese2, Day(aCell))
    End If
    
   A = aCell.Offset(0, -3).Value
   B = aCell.Offset(0, 2).Value
   
   ActiveCell.Value = nuovadata
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = flusso1
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = flusso2
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select


  ElseIf (n = 4) Then
   'grandezze di interesse. Qua vanno ricavati 4 flussi
   anno = IIf(Month(aCell) > mese, 2013, 2014)
   nuovadata = DateSerial(anno, Month(aCell), Day(aCell))
   oggi = Date
   mese1 = Month(aCell) - 3
   flusso1 = DateSerial(anno, mese1, Day(aCell))
   mese2 = Month(aCell) - 6
   flusso2 = DateSerial(anno, mese2, Day(aCell))
   mese3 = Month(aCell) - 9
   flusso3 = DateSerial(anno, mese3, Day(aCell))
        
     If flusso1 < oggi And flusso2 < oggi And flusso3 < oggi Then
     mese1 = Month(aCell) + 3
     flusso1 = DateSerial(anno, mese1, Day(aCell))
     mese2 = Month(aCell) + 6
     flusso2 = DateSerial(anno, mese2, Day(aCell))
     mese3 = Month(aCell) + 9
     flusso3 = DateSerial(anno, mese3, Day(aCell))
     ElseIf flusso1 > oggi And flusso2 < oggi And flusso3 < oggi Then
     mese2 = mese1 + 6
     flusso2 = DateSerial(anno, mese2, Day(aCell))
     mese3 = mese1 + 9
     flusso3 = DateSerial(anno, mese3, Day(aCell))
     ElseIf flusso1 > oggi And flusso2 > oggi And flusso3 < oggi Then
     mese3 = mese1 + 6
     flusso3 = DateSerial(anno, mese3, Day(aCell))
     End If
     
   A = aCell.Offset(0, -3).Value
   B = aCell.Offset(0, 2).Value

   ActiveCell.Value = nuovadata
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = flusso1
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = flusso2
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
   ActiveCell.Value = flusso3
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Formula = (A * B) / n
   ActiveCell.Offset(0, 1).Value = aCell.Offset(0, 6).Value
   ActiveCell.Offset(1, -1).Select
    
  End If
 End If
Next

'ordinamento
Uriga = sh2.Cells(Rows.Count, 11).End(xlUp).Row
sh2.Range("K19:M" & Uriga).Sort Key1:=Range("K19:K" & Uriga), Order1:=xlAscending, DataOption1:=xlSortNormal

End Sub

di Luca (utente non iscritto) data: 16/12/2013 10:52:04
Il codice lungo vi ha spaventato eh? :D

Ho fatto un piccolo passo avanti: in pratica sicuramente parte dell'errore era dovuto al fatto che alcune celle non avevano commenti, quindi il testo del commento era nullo e non riesce ad assegnarlo alla variabile n.

Ho riscritto il codice togliendo tutto quello che non serve, per renderlo molto più breve, ho messo commenti a tutte le celle del range, ma qualcosa ancora non va. Il codice fa quello che deve fare, ovvero copia uno sotto l'altro i commenti delle celle del range, ma alla fine da errore: "mi dice variabile oggetto o variabile del blocco with non impostata", riferendosi alla riga con n.

Perchè?

Sub flussi_di_cassa_ridotto()

 Dim oTbl As ListObject
 Dim oCmt1 As Comment
 Dim oCmt2 As Comment
 Dim oneRange As Range
 Dim aCell As Range
 'Dim n As String
 
 'come ottengo la prima riga vuota partendo dall'alto?
 Set sh1 = Workbooks("CC.xlsm").Worksheets("rendimento")
 Set sh2 = Workbooks("CC.xlsm").Worksheets("flussi di cassa--cedole")
 Set SourceRange = sh2.Range("K19")
 
 Set oTbl = Worksheets("rendimento").ListObjects("Tabella11")
 'definisco il range delle date
 UltimaRigafoglio1 = sh1.Range("D65536").End(xlUp).Row
 Set oneRange = sh1.Range("D31:D" & UltimaRigafoglio1)
 Set aCell = sh1.Range("D31")
 
 'seleziono il mese attuale
 mese = Month(sh1.Range("B4"))

 'seleziono la prima cella in cui deve copiare delle date (anche questo deve essere variabile)
 Sheets("flussi di cassa--cedole").Activate
 sh2.Range("K19").Select

For Each aCell In oneRange
  
 Set oCmt1 = aCell.Comment

 n = oCmt1.Text
  If (n = 1) Then
   ActiveCell.Value = n
   ActiveCell.Offset(1, 0).Select
  ElseIf (n = 2) Then
   ActiveCell.Value = n
   ActiveCell.Offset(1, 0).Select
  End If
 
Next

End Sub

di paolomath data: 16/12/2013 11:45:23
Ciao,

cosa succede se non c'è commento?

Prova ad inserire, dopo Set oCmt1 = aCell.Comment:

If oCmt1 Is Nothing Then
Else
n = oCmt1.Text

......

End If

Bye bye.
di Luca (utente non iscritto) data: 16/12/2013 15:09:51
Grandissimo!!! funziona!!

Vuoi Approfondire?