Ciclo e Right

Hai un problema con Excel?

Nuova discussione

Ciclo e Right
di Toscanaccio (utente non iscritto) data: 02/02/2016 12:20:42
Salve a tutti!
Continuo a stressarvi con le richieste di aiuto...
Ho la seguente macro che, a onor del vero, funziona molto bene, alla cui definizione sono arrivato grazie ad alcuni aiuti dei quali. Di questi alcuni erano per me incomprensibili ma mi sono limitato a seguirli pedissequamente.
Forse proprio per questo cercando di migliorare il codice non ci sono riuscito ed ecco la richiesta di aiuto.
Il codice attualmente prende il n° di contratto, che è univoco di 6 cifre (es.123456), dalla cella selezionata per applicargli un iperlink che mi permetta di aprire l'accordo stesso andandolo a pescare nella cartella che vedete (una sottocartella chiamata "Accordi" della cartella in cui risiede il file xls. I numeri di contratto sono tutti incolonnati in ordine di data.
Le modifiche che vorrei fare sono le seguenti:
1) dal momento che alcuni accordi non contengono solo il n° ma anche altri caratteri (ad es.: Aggiunta 123456) facendo comunque capo all'accordo 123456 ho provato a mettere
"set valoreDaCercare = Right(cls,6)"
Ma mi da errore: cosa devo fare?
2) Attualmente devo selezionare una cella e poi avviare la macro, una cella alla volta: come fare un ciclo in modo che selezionando n celle ad ognuna di esse assegni il giusto iperlink?
Grazie per l'attenzione.
Massimo

Sub SoloIperlink()
'
' SoloIperlink Macro
' Macro registrata il 01/02/2014 da MC
' Scelta rapida da tastiera Ctrl+i
'
      ActiveSheet.Unprotect
  Dim cls As Range
Dim valoreDaCercare As Range
Dim strLnk As String



Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "ACCORDI")
Set colFiles = objFolder.Files

For Each cls In Selection
    Set valoreDaCercare = cls
Next

Dim pippo As String


For Each objFile In colFiles
   
   If (InStr(objFile.Name, valoreDaCercare.Value) > 0) Then

        Set pluto = ActiveSheet

        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="ACCORDI" & objFile.Name
   End If
Next

    Selection.Font.Bold = True

End Sub

di alfrimpa data: 02/02/2016 12:29:23
Ciao Massimo

Esprimo solo il mio parere e magari sbaglio ma tu hai dichiarato le variabili cls e valoreDaCercare come Range quindi non credo che si possa utilizzare l'istruzione Right che opera solo sulle stringhe.

Alfredo

di Toscanaccio (utente non iscritto) data: 02/02/2016 12:51:07
Ciao Alfredo, ben ritrovato
Ho provato ad introdurre la variabile cellaintera as string, e poi
Set valoreDaCercare = Right(CellaIntera, 6)
Sembrerebbe che cellaintera arrivi ad avere valore "123456" ma la riga di comando qui sopra da errore
ma ugualmente non gira.
Allego codice.
Massimo

Sub SoloIperlinkFrancesco()
'
' SoloIperlink Macro
' Macro registrata il 01/02/2014 da MC
' Scelta rapida da tastiera Ctrl+i
'
      ActiveSheet.Unprotect
  Dim cls As Range
Dim valoreDaCercare As Range
Dim CellaIntera As String
Dim strLnk As String


Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "ACCORDI")
Set colFiles = objFolder.Files

For Each cls In Selection
    CellaIntera = cls
    Set valoreDaCercare = Right(CellaIntera, 6)
Next

Dim pippo As String


For Each objFile In colFiles
   
   If (InStr(objFile.Name, valoreDaCercare.Value) > 0) Then
 
        Set pluto = ActiveSheet
     
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="ACCORDI" & objFile.Name
   End If
Next

    Selection.Font.Bold = True
     
End Sub

di alfrimpa data: 02/02/2016 13:46:44
Massimo CellaIntera è una variabile di tipo String e cls di tipo Range quindi non puoi scrivere

CellaIntera = cls

Dovresti scrivere

CellaIntera = cls.Value

sempreché in cls ci sia una stringa; diversamente devi cambiare la tipologia di variabile di CellaIntera a seconda del dato che dovrà ospitare.

Tutto questo detto "al buio" non conoscendo il file.

Alfredo
di Toscanaccio (utente non iscritto) data: 02/02/2016 17:20:36
Provo ad allegare dei file di prova per fare un'esempio.
Al momento una cartella contiene il file xls ed una sotto cartella che si chiama Accordi con gli altri 2 file d'immagine

Attualmente avendo B2 attiva la macro ci incolla sopra l'iperlink che contiene la stringa 654321, e lo stesso in B3 per la stringa 123456.
Le 2 richieste:
1)con attiva b4 poter aprire 123456

2) Un ciclo che avendo selezionato l'intervallo b2:b4 termini dopo aver prodotto l'iperlink a tutt'e 3.

Probabilmente poi ci sarà da gestire l'eventuale errore se non trova la stringa.

Grazie, Massimo

di Mohican1989 data: 02/02/2016 23:34:05
Ciao, ho implementato il codice, supponendo che la discriminante in ogni cella siano gli ultimi sei numeri (654321) (123456) aggiunta paperinointero(123456) per cui che le celle prese in considerazione abbiano comunque come nome dell' immagine da linkare le ultime 6 cifre della stringa all' interno delle cella.

Per ora ho provato solo sul file come lo hai postato tu e sperando che chi immetta i dati non sbagli, non sono bravo a gestire gli errori. Bisogna provare se funziona anche su altre colonne.

Intanto questa ti chiede se il range a cui deve applicare l' sono 1 o più celle, se scrivi 1 la macro esegue il codice che avevi già postato, se inserisci + o altri numeri ti chiede di inserire l' indirizzo della cella di inizio range e l' indirizzo della finale. Dopo svolge alcuni controlli sulla lunghezza dell' indirizzo (per ora ho fatto il check per range a 2 char di lunghezza (da b1 a b9), dovrebbe funzionare anche con range che iniziano con lunghezza char 2 e finiscono con lunghezza char 3. Bisogna implementare tutti gli altri tipi nel caso.
Dopodiche prende i 6caratteri + a destra contenuti nelle stringhe e li carica in un array e infine cicla l' array vs ogni file contenuto nella cartella e se viene trovato viene creato l' hyperlink .

EDIT: Ovviamente puoi togliere il msgbox(links(x)) mi serviva per verificare se l array veniva caricata correttamente.

Sub SoloIperlink()
'
' SoloIperlink Macro
' Macro registrata il 02/02/2016 da MC
'
' Scelta rapida da tastiera: CTRL+i

'
      ActiveSheet.Unprotect
  Dim cls As Variant
Dim valoreDaCercare As String
Dim strLnk As String
Dim Links() As String
Dim RangeImmissioneHyperlink As Range


Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "ACCORDI")
Set colfiles = objFolder.Files
scelta = InputBox("Il range contiene 1 o più celle ? (1,+)")
If scelta = 1 Then
    indirizzo = InputBox("Indirizzo della cella ?")
    Set RangeImmissioneHyperlink = Range(indirizzo)
Else
    iniziorange = InputBox("Inizio Range?")
    finerange = InputBox("Fine Range?")
    Set RangeImmissioneHyperlink = Range(iniziorange & ":" & finerange)
End If

RangeImmissioneHyperlink.Select

ReDim Preserve Links(Range("b1").End(xlDown).Row)
If scelta = 1 Then
    For Each cls In RangeImmissioneHyperlink
        Links(1) = cls.Value
        valoreDaCercare = Right(Links(1), 6)
        
    Next
Else
    If Len(finerange) > 2 And Len(finerange) = 3 Then
        If Len(iniziorange) = 2 Then
            For x = 1 To Right(finerange, 2) - Right(iniziorange, 1) + 1
                Links(x) = Right(Range(Left(iniziorange, 1) & Right(iniziorange, 1) + x - 1), 6)
                
            Next
    
        Else
            MsgBox ("Da implementare"): Exit Sub
        End If
    ElseIf Len(finerange) = 2 Then
        
        For x = 1 To (Right(finerange, 1) - Right(iniziorange, 1) + 1)
            Links(x) = Right(Range(Left(iniziorange, 1) & Right(iniziorange, 1) + x - 1), 6)
            MsgBox (Links(x))
        Next
    Else
    
        MsgBox ("Da implementare"): Exit Sub
    End If
End If
Dim pippo As String

If scelta = 1 Then
    For Each objfile In colfiles
       
       
           If (InStr(objfile.Name, valoreDaCercare) > 0) Then
        
                Set pluto = ActiveSheet
        
                ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="ACCORDI" & objfile.Name
           End If
        
    Next
ElseIf Len(finerange) > 2 And Len(finerange) = 3 Then
        If Len(iniziorange) = 2 Then
        For Each objfile In colfiles
            For Z = 1 To (Right(finerange, 2) - Right(iniziorange, 1) + 1)
                If (InStr(objfile.Name, Links(Z)) > 0) Then
                    ActiveSheet.Range(Left(iniziorange, 1) & Right(iniziorange, 1) + Z - 1).Select
                    Set pluto = ActiveSheet
                    
                    ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="ACCORDI" & objfile.Name
                       
                    Selection.Font.Bold = True
                End If
            Next
        Next
        End If
ElseIf Len(finerange) = 2 Then
        For Each objfile In colfiles
        For Z = 1 To (Right(finerange, 1) - Right(iniziorange, 1) + 1)
            If (InStr(objfile.Name, Links(Z)) > 0) Then
                ActiveSheet.Range(Left(iniziorange, 1) & Right(iniziorange, 1) + Z - 1).Select
                Set pluto = ActiveSheet
                ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="ACCORDI" & objfile.Name
                Selection.Font.Bold = True
            End If
        Next
        Next
End If

End Sub

di Toscanaccio (utente non iscritto) data: 03/02/2016 16:50:20
Ciao!
Ho visto quanto postato.
Appena l'avrò testato vi farò sapere.
Per intanto ringrazio!
Massimo
di Toscanaccio (utente non iscritto) data: 03/02/2016 19:04:51
Intanto un grazie a chiunque si interessi alle mie peripezie.

Dunque Mohican1989: Prime valutazioni (da ignorantone quale sono)
1) La lunghezza dell'indirizzo va allungata poichè sul foglio in cui effettivamente dovrà girare ho provato sul range AJ121:AJ123 e non ha girato. Come mai l'avevi limitato? Se si lasciasse "libero" cosa potrebbe succedere?

2) Al di là di questo: c'è sicuramente un motivo che ti ha spinto a scriverlo con i vari MsgBox, ma a me sfugge.
Per semplificare la ricerca e la praticità io l'avrei fatta semplicemente sulla selezione:
seleziono le celle da AJ121 a AJ123 (che corrispondono quindi ad iniziorange e finerange) ed avvio la macro per ottenere il risultato (o la mia ignoranza ed inesperienza non mi fanno vedere cose importanti?). Oltretutto ho provato a rispondere al MsgBox (1, +) con iniziorange=finerange ossia con una sola cella selezionata e la macro non ne ha risentito: potrebbe essere alleggerito il codice dell'if allora? (se c'è una sola cella ile variabili nizio e fine range coincidono)

3) Ultima domanda che ti faccio:Mi è sembrato di vedere che anche quando è stato trovato il file da linkare la routine continua a scansionare anche gli altri file rimanenti della cartella Accordi. Dal momento che i numeri d'accordo sono univoci e tutti di 6 numeri una volta trovata la corrispondenza del file, non sarebbe più semplice e veloce interrompere la ricerca e passare a cercare l'iperlink successivo (se c'è)?
Ti ringrazio per il tempo che ci dedicate e per le eventuali spiegazioni.
A presto,
Massimo
di Mohican1989 data: 03/02/2016 20:29:07
Ciao Toscanaccio, premetto, il codice l ho buttato gù ieri sera per addormentarmi ^^ era solo per dare un la e vedere se la strada poteva essere quella corretta, ci sono sicuramente miglioramenti e pulizie da fare.
1)Non l ho tanto bloccata, non ho avuto semplicemente tempo per scrivere i diversi casi in cui poteva rientrare un range di celle. Almeno con il metodo che stavo usando se prendi colonne come AJ12 dovrei verificare anche se i primi due caratteri sono numeri etc etc ma si può sicuramente fare.
2)I msgbox erano stati immessi nel caso in cui si fosse scelto un range per cui non avevo scritto il codice ma pensavo al massimo che venissero prese in considerazione colonne dalla A alla Z.Si il codice può essere alleggerito.Di fatto avrei dovuto indicare che se non si scrive 1 o + di uscire dalla routine (non puoi scrivere "PIPPO" se ti chiedo quante sono le celle del range interessato). Come mi hai fatto notare, tu hai scritto un espressione logica ma per il codice che ho scritto (eh si era molto da ripulire) prendeva in considerazione solo se avevi scritto 1, allora eseguiva il codice per 1 cella di cui inserivi l' indirizzo, altrimenti anche se scrivevi "ciao" piuttosto che 3+2-1+3 oppure "STICAZZI123" ti chiedeva inizio e fine range dando per scontato che chi non inserisce 1 intenda che ci sono più celle.
3) Assolutamente si, ci ho pensato stamattina sul tragitto per il lavoro, certamente su 2 immagini risulta veloce ma se hai 1000 file risulta lungo e inutile se sono come hai detto univoci(certo lo devono essere :babbo:) possiamo aggiungere tranquillamente un uscita dal ciclo una volta trovato.

Per quanto riguarda usare per semplicità il range di celle selezionate si puo provare ma ieri ero partito su questa strada è l ho proposta. Intanto stasera aggiusto il codice

EDIT: aggiungo, vedo ora che avevo anche impostato la grandezza della matrice su quanto da te indicato ma ovviamente dovendo essere dinamica il codice è diverso.

Per curiosità, tua conoscenza di vba ?
di Toscanaccio (utente non iscritto) data: 04/02/2016 18:09:02
Ciao!
Dunque: Questa routine la uso su 2 fogli distinti il primo che è quello di inserimento e che contiene un n° generalmente non superiore a 20 righe e che ha 25 colonne. I n° accordo sono nella colonna e le righe sono ordinate secondo la colonna F che contiene una data allo scadere della quale le righe, con apposita macro, sono spostate e passano in un secondo foglio di "Archivio" di 59 colonne con le prime 38 bloccate e che quindi ha i n° accordo nella colonna AJ a partire dalla riga 39... in giù. Nel primo foglio la macro viene lanciata da un'altra che lascia la cella in questione selezionata e che quindi mi ha spinto a Modificare così quanto tu hai scritto:
If scelta = 1 Then
indirizzo = ActiveCell.Address
'indirizzo = InputBox("Indirizzo della cella ?").

L'utilizzo invece nel foglio Archivio è dovuto al recupero di link che in qualche modo si sono persi (non so perchè ma più di una volta il link è risultato sbagliato; il sospetto che ho è che le nuove entrate nel foglio archivi sono inserite nel rigo 39 facendo scorrere in giù le precedenti prendendo l'iperlink già presente nella cella AJ39 comunque prove specifiche non m'hanno confermato questo sospetto. Da qui la necessità di ripristinare il link corretto su più righe (da qui la necessità dell'array).
In buona sostanza mentre nel primo foglio la routine originaria che ho postato faceva meravigliosamente bene il suo compito, nel secondo devo lanciarla rigo per rigo. Forse potrebbe essere sufficiente una macro che mi lancia quella originaria per tutte le celle comprese nel range (cioè le celle selezionate).
Altro discorso è quello del right che volevo implementare.
I nomi dei file da cercare sono così composti: Nome=gg-mm-aaaa=abc123456.jpg dove nome può contenere il carattere . già dal secondo carattere, = è usato come segno separatore ed ABC è una sigla di 3 lettere.
Le mie conoscenze di vba: molto casarecce , più delle volte date dall'interpretazione di ciò che fa il registratore di macro per apportare le opportune modifiche. Ho scritto così parecchi codici che probabilmente farebbero inorridire voi puristi ma che .... funzionano, ed ho questa piccola soddisfazione.
Ma quando si parla di Dim, Set , Obj... e diavolerie simili per me inizia a diventare ostrogoto. Mi piacerebbe approfondire , ma non ho mai trovato il tempo ed un manuale semplice semplice che ti prenda per mano...
Ciao, Massimo
di Toscanaccio (utente non iscritto) data: 04/02/2016 18:17:15
Errata C.:
Non ho riletto prima d'inviare e ci sono dei refusi.

Dunque: Questa routine la uso su 2 fogli distinti il primo che è quello di inserimento e che contiene un n° generalmente non superiore a 20 righe e che ha 25 colonne. I n° accordo sono nella colonna E e le righe sono ordinate secondo la colonna F che contiene una data allo scadere della quale le righe, con apposita macro, sono spostate e passano in un secondo foglio di "Archivio" di 59 colonne con le prime 38 RIGHE bloccate e che quindi ha i n° accordo nella colonna AJ a partire dalla riga 39... in giù. Nel primo foglio la macro viene lanciata da un'altra che lascia la cella in questione selezionata e che quindi mi ha spinto a Modificare così quanto tu hai scritto: ecc, ecc.... [omissis]

P.S. se tu l'hai buttato giù così prima di dormirre, a me sarebbe costato (senza riuscirci) molto, molto tempo.....

di Mohican1989 data: 04/02/2016 21:20:22
Prova ora, probabilmente non avevo letto bene i tuoi primi post e mi sono lanciato in una routine lunghissima che invece poteva essere risolta in pochi minuti.

Ovviamente prima seleziona l' area a cui vuoi mettere gli hyperlink.

Spero sia ok e fidati un po di tempo per imparare si trova, io non ho studiato informatica ma al lavoro se non avessi imparato un po di vba (piccola azienda solo excel e gestionali non rinomati) avrei passato ore (anzi le ho passate visto che quando ci sono entrato non sapevo manco cos' era una cella) a fare azioni manuali.

' Macro registrata il 01/02/2014 da MC
' Scelta rapida da tastiera Ctrl+i
'
      ActiveSheet.Unprotect
  Dim cls As Range
Dim rangeprogressivo As Range
Dim valoredacercare As String
Dim strLnk As String



Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "ACCORDI")
Set colFiles = objFolder.Files

For Each cls In Selection
    Set rangeprogressivo = cls
    valoredacercare = Right(rangeprogressivo, 6)
    
    For Each objFile In colFiles
   
        If (InStr(objFile.Name, valoredacercare) > 0) Then

            Set pluto = ActiveSheet

             ActiveSheet.Hyperlinks.Add Anchor:=rangeprogressivo, Address:="ACCORDI" & objFile.Name
    Exit For
        End If
Next

    
Next

Selection.Font.Bold = True
Dim pippo As String


End Sub

di Toscanaccio (utente non iscritto) data: 05/02/2016 13:08:14
Ciao!
Mi sembra che giri egregiamente!
Sto apportando alcune modifiche che poi ti posterò.
Per intanto grazie mille!;
Massimo

Vuoi Approfondire?