: Vorrei Risolvere Questi tre Problemi in Excel

[A.Maurizio]

Ciao a tutti , mi chimo Maurizio , mi scuso con voi sé sono rimasto molto a lungo senza mai Farmi sentire da voi ; ma sono stato via per lavoro .
Ciò non vul dire che non Abbia continuato a pensare a voi , Edecco Spiegato il Motivo per qui ho Volutamente inserito queste tre mie richieste in un solo Documento .
1° ) Richiesta :

Codice: Seleziona tutto

For Each C In Range("A1:F20")
If Application.CountIf(Range("H1:M1"), C) >= 1 Then C.Interior.ColorIndex = 6
Next

Chiedo Scusa sin da Ora , se per Spiegare meglio ciò che intendo Dire o Voler fare , sono Partito con questo Breve Schemino : Ma credetemi : quando dico che mi e già Difficile poterlo spiegare a parole ; figuriamoci poi , sé devo metterlo per Iscritto ! Il Dunque e questo .
Se Guardiamo Attentamente questo Esempio Riportato Sopra , Che trà le altre cose Funziona Benissimo ; Notiamo che tutto cio’ che scrivo nelle celle che Vanno da ( A1:F20 ) che corrispondo a tutto ciò che scrivo Nelle Celle che vanno da ( H1:M1 ) si Devono Colorare di Giallo .
E fino a qui nulla di Problematico : Ora però Provando e Riprovando più volte questo Concetto ; Io che sono un Curioso di Natura , non potevo farmi sorgere una Domanda ben precisa : e qui entrate in ballo Voi .
La mia Domanda e questa : E’ sé Io Avessi Sei Numeri Per ogni cella a partire da ( A1:A20 ) e volessi Trovare l’essatta Corrispondenza di uno o più numeri che si Trovano all’interno della Cella ( H1 ) e a sua volta per poter Evidenziare i Numeri o il Numero Trovato per ogni Cella , volessi cambiare il Suo Font da Nero a Rosso compreso il Suo Font.size = 14 .
Tutto ciò Sarebbe possibile ! o no ? – Io non vi Nego che a tempo Perso o Voluto provare Sfruttando la Tecnica del Database , quando si cerca di trovare un determinato dato , ma l’unica cosa che sono riuscito ad Ottenere e Stata quella di Trovare si ! ; L’elemento Voluto ma solo per il primo che incontravo e non per tutte le altre celle .
2° ) Richiesta :

Codice: Seleziona tutto

If I >= 30 Then
I = I + 1
UserForm1.Height = I
Else
End if

Anni fa , quando Lavoravo con Visual Basic 6.0 , Ero riuscito a Creare con questo piccolo Schemino , una sorta di Chiusura in Modo Orizzontale o Verticale del Mio Form : In Maniera più o meno lenta a Seconda Della della mia Volontà .
E anche vero che in quel Caso mi avvalevo di un oggetto chiamato Time ; Ora volevo sapere da voi se c’è un modo per Ottenere tutto ciò anche con un UserForm in Excel .
Anche qui non vi nego d’averci provato con tutto il mio sapere ; ma l’unica cosa che sono Riuscito ad ottenere , e Stato si una chiusura in modo Orizzontale ho Verticale che sia ; ma il Tutto Avviene in Modo molto Rapido e quasi Impercettibile .
Voi Gentilmente Riuscireste a darmi una mano anche in questa mia Richiesta .
3° ) Ed Ultima mia Richiesta
Questa mia Richiesta , Sicuramente vi Darà del Filo da Torcere , in quanto risale all’incirca agli hanni 80 ; quando si Studiava ancora i concetti del Dos .
Il Discorso e questo : In quei anni li ! Avevo trovato il modo scrivendo questa procedura ; che ho Tentato di Ritrascrivere per voi in formato VBA :

Codice: Seleziona tutto

10 : On Error Resume Next
20 : Range("A1").Value = M$ = "Salve a tutti come và...!"
30 : For I = 1 To Len(M$) : Range("A1").Value = M$(I): Pause 1 + 2 * (M$(I) <> Chr(32))
40 : Next I
50 : Return
End Sub

In Pratica : Questo Listato dice che Tutto ciò che veniva Scritto in ( M$ ) alla Linea 20 .
Deve Essere riportato a Video , in modo Tale che sia Scritto ; come se’ una Persona Usasse una Macchina da Scrivere .
Forse per voi , il tutto può Risultare una cosa Banale ed Inutile ; ma a me piaceva molto usare questa Forma di Scrittura nelle mie Conferenze .
Ora non pretendo che mi facciate tutto alla velocità della Luce , e in ogni caso ; A tutti i costi .
Ma lascio a voi libero Arbitrio su tali mie proposte .
Per il Resto come Sempre vi Porgo i miei più Sinceri casuti e un Grazie Infinite per tutto L’aiuto che riuscirete a darmi in merito ; Da A. Maurizio .
(N.B) La Trascrizione in Besic del Listato Visto Sopra è :

Codice: Seleziona tutto

10 : Print at 2,0 ;  : Let M$ = "Salve a tutti come và...!"
20 : For I = 1 to Len M$ : Print M$ (I) ;  : Pause 1 + 2 * (M$(I) <> chr 32 ) : Next I : Return

Se vi Può Servire a qualche cosa ! Grazie

[wallace&gromit]

mi chiamo Maurizio

Ciao Maurizio, certo, ti conosciamo!
Premetto che non so darti le soluzioni ai quesiti, ma ti faccio alcune domande che magari aiutano a spiegare la situazione a chi cercherà di risolvere.
Punto 1) ma nelle singole celle hai un elenco di vari numeri? se sì come sono separati tra di loro?
Punto 2) la cosa sembra interessante, ma da quel poco che hai scritto sembrerebbe che la userform si ingrandisca ad ogni ciclo e dalle tue parole invece mi sembra che tu la voglia far rimpicciolire.
Punto 3) questa mi sembra la richiesta più chiara, penso non sia difficile metterla in pratica.

[Anthony47]

Se vuoi individuare se in una cella contenente una stringa col testo di piu' numeri c' e' un testo specifico (quello corrispondente al numero in H1) puoi usare varie tecniche; io suggerisco questo approccio:

Codice: Seleziona tutto

Dim mySplit As Variant, myMatch As Variant
For Each Cell In Range("A1:A20")
    If Len(Cell.Value) > 0 Then
        mySplit = Split(Cell.Value, " ", -1, vbTextCompare)
        myMatch = Application.Match(CStr(Range("H1").Value), mySplit, 0)
'
        If Not IsError(myMatch) Then
        'Istruzioni per cambiare il formato del testo
            myScr = Application.WorksheetFunction.Substitute( _
                Application.WorksheetFunction.Substitute(" " & Cell.Value & " ", " ", "#", myMatch), _
                " ", "@", myMatch)
            myStart = InStr(1, myScr, "#")
            myStop = InStr(1, myScr, "@")
            With Cell.Characters(Start:=myStart, Length:=(myStop - myStart)).Font
            'Qui formatta il font come ti piace; vedi help on line per tutte le possibili proprieta'
                .Name = "Arial"
                .FontStyle = "Normale"
                .Size = 16
                .ColorIndex = xlAutomatic
                .Shadow = False
                .Bold = True
                .Italic = False
                .Underline = False
            End With
        End If
    End If
Next Cell

Per il punto 2, se il tuo obiettivo e' rallentare il loop allora puoi inserire nello stesso loop queste istruzioni:

Codice: Seleziona tutto

    myTim = Timer
    Do
        If Timer - 0.1 > myTim Or myTim > Timer Then Exit Do   'Attesa 0.1 sec
        DoEvents
    Loop


Questa attende 0.1 secondi; se vuoi una attesa diversa modifica lo "0.1", mantenendo la sintassi.

Per il quesito 3 potrai usare un loop del tipo

Codice: Seleziona tutto

stringa = "La mia frase storica"
For i = 1 To Len(stringa)
    Range("L1").Value = Left(stringa, i)
Next i

Immagino che vorrai rallentare il loop, e per questo userai il codice del quesito precedente.

Ciao

[A.Maurizio]

Ciao a Tutti ; Devo dire che Siete Simpaticissimi oltre che molto preparati , Comunque sia le cose Stanno Cosi :
1° ) Per quello che riguarda il Primo problema , e che partendo Dalla cella A1 arrivando fino alla Cella A20 per farla Breve ; ho Impostato una Serie di " Sei Numeri " per Ogni Cella ; Presi a Caso che variano dall' 1 al 90 .
Mentre Nella Cella H1 Ho inserito le Cosi dette mie Giocate .
Ora questi Sei Numeri in Forma Crescente dal più Rande al più piccolo che si trovano all'interno di Tale celle ; non ho Idea se si Meglio , Separarle con una Virgola ; Un Punto ; o un Trattino ; Ecco perché nella mia Domanda avevo Scritto , Vedete un Puchino voi cosa può essere più valido per non Creare dei Problemi con L'andamento del Programma .
Detto questo una volta Trovato i numeri Corrispondenti che immetto nella Sola Cella H1 ; Si dovrà poter fare una Ricerca di Quanti numeri Corrispondono a partire Dalla cella A1 alla Cella A20 ; Faccio un Esempio Pratico :
Ipotizziamo che nella Cella H1 Io scriva i numeri ( 3 - 5 - 12 - 25 - 30 - 43 ) ; E che nella Cella A5 ci siano Scritti i Seguenti Numeri :
( 2 - 7 - 20 - 25 - 35 - 43 ) ; Ora come Possiamo notare gli unici Due numeri che Corrispondono alla Cella H1 sono i Numeri ( 25 - 43 ) .
A questo punto il Programma stesso dovrebbe poter Evidenziare con un " Font " questi due Numeri di Colore Rosso e a Sua Volta Variare alche la grandezza del Suo Carattere , Sempre che sia Possibile ; Come ad Esempio Inserire su di Essi un " Font.Size=14 ".
Tutto qui ! si fa per Dire ? .

2° ) Per quello che riguarda la mia Seconda Richiesta è proprio quella di Riuscire a far si che al premere un tasto di chiusura dell' UserForm esso si Possa chiudere Ho in modo Orizzontale ho in Modo Verticale ; Ma non in modo come dire " Detto fatto " ! ma in modo graduale .
Anche io Avevo Pensato di inserire il Tutto all'interno di una procedura che Serviva conto alla Rovescia ; ma era un Disastro .
Ora proverò come mi avete suggerito Voi , Poi vi farò Sapere ! ma Sinceramente parlando non ho Dubbi che la cosa Come Sempre Funzionerà Benissimo .
in quanto Siete veramente in Gamba .

3 ° ) Per quello che Riguarda Invece l'ultima mia Richiesta e quella che mi piacerebbe che nel premere un Tasto , che o Posizionato sul Foglio di lavoro ; Esso possa Richiamare una Procedura che possa far si che mi faccia comparire nella cella Ipotetica ( A1 ) un Mio Discorso già Pre_Compilato nel programma Stesso ; in modo tale che Avviando tale Procedura , Essa mi Possa far ritrascrivere Esattamente parola per parola , nella Cella (A1) tale Discorso in modo che sembri scritto sul momento da una Telescrivente o da una Macchina da Scrivere .
Come ad Esempio : Le lettere che Verranno riportate a Video non Dovranno avere una Velocita ne troppo Sostenuta , ma neppure troppo Lenta .
Anche qui Spero di essere stato Abbastanza chiaro ; e questo e Tutto Un Ulteriore Grazie ancora Di Tutto Cuore a Tutti Voi , Sinceri saluti da A. Maurizio

[A.Maurizio]

Ciao a Tutti Voi ; Sono Sempre Io Maurizio , Vi Scrivo in quanto L'ultima Volta che abbiamo Trattato questo Argomento Pensavo di Essere Riuscito ad Esprimermi al Meglio , in modo che voi Capiste bene quali erano le mie Richieste , ma non e proprio Cosi .
mi Spiego Meglio : Avevo chiesto di Farmi Avere un modo per Chiudere un UserForm in modo Alternativo ; è fino a qui non ci piove , Ora ho Provato il Vostro Programmino che gentilmente mi avete offerto , ma la cosa non Funziona ; Oppure non sono in Grado Io di farla funzionare a dovere , M il Motivo e questo : in un Modulo o riportato tutto questo :

Sub Restringi_Form_Quando_Chiudi()
On Error Resume Next
myTim = Timer
Do
If Timer - 10 > myTim Or myTim > Timer Then Exit Do 'Attesa 0.1 sec
DoEvents
Loop

If I >= 15 Then 'se si usa un numero minore di 15 o un intervallo
'del timer inferiore (in qst caso l'intervallo è 1
'si può solo diminuire la velocità
I = I + 1 'significa: altezza del form (I) = altezza del form - 15 twips
UserForm1.Height = I
Else
UserForm1.Height = 15 'se l'altezza rimanente è inferiore a 15 twips, non posso
'sottrarle 15 twips (l'altezza del form non può essere un numero negativo)
End If
End
End Sub

Come Potete notare e parte del Mio Listato più il Vostro .
Però Tutto ciò che sono Riuscito ad ottenere da Tutto ciò ! e né più e né meno che quello che ero riuscito ad ottenere usando un Listato per il Conto alla Rovescia ; Per qui e vero che Rallenta il tutto prima di chiudere il Form Definitivamente ; Ma non in modo Sincronizzato .
Mi Spiego Meglio : Quello che Avevo Creato Io Stesso progetto Usando il VB6 , il Mio Form si Chiudeva Nel Momento in qui Premevo il tasto Chiudi in Modo Molto lento a Seconda del Tempo che gli Imponevo Io da programma , per poi Scomparire del Tutto .
Il Tutto Avveniva un pochino come Sé Boi Vedessimo una lancetta dei Secondi di un Orologio che dal Numero 1 raggiunge il Numero 12 .
Non so sé questa Volta sono riuscito a rendervi un Idea Precisa di Ciò che vorrei realizzare ! .
Sinceri Saluti da A. Maurizio

[Anthony47]

Se vuoi chiudere in modo morbido una userform puoi usare un codice come questo:

Codice: Seleziona tutto

Private Sub UserForm_Click()
Dim aaaW As Long, aaaH As Long, I As Single, myTot As Long, myDel As Single
aaaW = UserForm1.Width
aaaH = UserForm1.Height
myDel = 0.1     '<< Il ritardo tra ogni ridimensionamento
myTot = 0       '<< Il tempo totale di chiusura della form
If myDel = 0 Then myDel = 0.1
If myTot = 0 Then myTot = 1
For I = myTot To myDel Step (-myDel)
    myTim = Timer
    UserForm1.Width = aaaW * (I / myTot)
    UserForm1.Height = aaaH * (I / myTot)
    Do
        If Timer - myDel > myTim Or myTim > Timer Then Exit Do   'Attesa
        DoEvents
    Loop
    If aaaH * (I / myTot) < 25 Then Exit For
Next I
UserForm1.Hide         'Chiudi alla fine
UserForm1.Width = aaaW 'Ripristina dimensioni
UserForm1.Height = aaaH
End Sub

Io l' ho associato al click della stessa form, ma il codice puo' essere usato in qualsiasi macro.

Ciao

[A.Maurizio]

Grazie a tutti voi per la Vostra proverbiale Pazienza , E un Grazie Mille in assoluto a te Anthony47 ; Questo tuo Ultimo Aiuto inerente all'userform era proprio ciò che stavo cercando .
Ti Ringrazio tantissimo ; anche perché questo tuo ultimo Intervento mi da la Possibilità di abbellire meglio questo mio ultimo Programma , non appena l'avrò ultimato vi invierò una copia nel modo in qui tempo fa mi aveva Suggerito il Sig : Scossa .
In quanto ho scaricato da Internet l'applicazione Dropbox e o Seguito tutte le Indicazioni che Scossa mi aveva Suggerito di fare , per qui non dovrò fare altro che provare il tutto . Nel Frattempo vi invio i miei più sinceri saluti , e un grazie ancora di tutto da A. Maurizio