Funzione interattiva

[Statix]

Ciao a Tutti.
volevo chiedere se è possibile
con una funzione o altro,
fare in modo che cliccando su una cella ,in un altra cella ,colonna H ,sempre della stessa riga,mi scriva il valore dell'intestazione della colonna.
colonna D1 = A
colonna E1 = B
colonna F1 = C
colonna E1 = D



esempio
se clicco la cella D2 in H2= A
se clicco la cella F3 in H3 = C

[Avatar3]

Nel VBA del foglio dati inserisci questa macro

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UR = Range("D" & Rows.Count).End(xlUp).Row
If UR < 2 Then UR = 2
CheckArea = "D2:G" & UR
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If Target <> "" Then
Riga = Target.Row
Col = Target.Column
Range("H" & Riga).Value = Cells(1, Col).Value
End If
End If
End Sub


Non hai specificato se in H hià esiste un valore o stringa può essere sostituito o no dalla nuova selezione
nel caso, credo, che tu possa provvedere da solo

[Statix]

Ciao Avatar3,
è perfetto,una vera sciccheria,
ti ringrazio moltissimo.
PS. idoneo nei primi 300 su 5000 concorrenti.
grazie al tuo contributo e quello di Anthony47,
il concorso continua

[Statix]

Scusami ,ti volevo chiedere un altra cosa,
in un post precedente,
ho chiesto come fare a non perdere la formattazione dell'apice,quando uso il cerca .vert
come ben tu sai ,con la tua macro che mi prendeva casualmente 100 domande in percentuali e tutte diverse ,
io ho applicato un cerca.verticale a questi record,purtroppo con la matematica perdo gli apici,
come posso fare per risolvere.
i dati sono disposti come nell'immagine,
sia il foglio1 che contiene tutte le 5000 domande che il foglio2 con 100 domande,
i fogli sono formattati testo.

[Avatar3]

Attraverso una macro
solito codice che conta le righe
il ciclo for...next
quando il valore di "A" è uguale al Valore "X" (sostituisce il cerca verticale, in un certo senso)
allora
worksheets("Foglio1").range("Casella con formula").copy destination:=worksheets("Foglio2").Range(casella Destinazione)
End If
Next RR
End Sub

[Statix]

Ciao Avatar3,
non sono riuscito ancora a capire il tutto,

nel Foglio 2, ho nella colonna B2 i cento record generati dalla prima macro,
adesso dovrei fare una macro con un ciclo For Next da 1 a 100
che mi cerca questi record nel Foglio1 e mi copia la riga del Range da C:M,
per ogni ciclo,
se puoi gentilmente postare la macro per intero,
grazie

[Avatar3]

Codice: Seleziona tutto

Sub CopiaR()
UR1 = Worksheets("Foglio1).Range("B" & Rows.Count).End(xlUp).Row
UR2 = Worksheets("Foglio2).Range("B" & Rows.Count).End(xlUp).Row
For RR2 to UR2
      For RR1 = 2 to UR1
            If Worksheets("Foglio2).Range("B"  & RR2).value = Worksheets("Foglio1).Range("B"  & RR1).value then
                   Worksheets("Foglio1).Range("C"  & RR1 & ":M" & RR1).Copy destination:=Worksheets("Foglio2).Range("C"  & RR2)
                 Goto saltaRR2
           End If
      Next RR1
SaltaRR2:
next RR2
End Sub

L'ho realizzata direttamente nel post e dovrebbe funzionare SE&O

[Statix]

C'è qualcosa che non va ,le scritte ,sono in rosso

Codice: Seleziona tutto

UR1 = Worksheets("Materie).Range("B" & Rows.Count).End(xlUp).Row
UR2 = Worksheets("Domande).Range("B" & Rows.Count).End(xlUp).Row
For RR2 to UR2

adesso me ne sono accorto mancavano delle virgolette,
continua a rimanere in rosso

For RR2 to UR2

[Avatar3]

Devi mettere i doppi apici al foglio ( mancano quelli in chiusura parentesi, li avevo dimenticati anche io )
Worksheets("Materie").........

[Statix]

Questo già l'avevo fatto,
continua a rimanere in rosso
For RR2 to UR2

[Avatar3]

Altro errore della "diretta"

Codice: Seleziona tutto

For RR2 = 2 to UR2


E' chiaro che dava errore

[Statix]

Ok adesso funziona,perche vedo le prime righe che le cambia,
ma impiega molto tempo sembra andare in loop,

[Avatar3]

Inserisci le due righe di codice che fermano il calcolo e lo ScreenUpdate
all'inizio della macro

e poi le ripristini all'uscita

[Statix]

Anche questo già fatto,
impiega ugualmente un bel pò di tempo.

[Avatar3]

Spero che tu non abbia messo quella macro all'interno di un ciclo

le tue formule cerca verticale le avevi sul foglio ed "entravano in funzione" quando il tuo ciclo delle 100 domande era terminato giusto?
bene!
alla fine della macro che mette casualmente 100 codici
devi avviare questa macro che assegnerà le 100 risposte

Ora nella peggiore delle ipotesi potrai avere 100 * 5000
quindi 500.000 confronti con 100 righe da copiare un tempo presumibile di circa 2 o 3 minuti al massimo

[Statix]

Infatti è proprio così,
provo con un altro computer molto più veloce di questo ,da dove stò facendo il test,
ci sentiamo più tardi e ti faccio sapere come va,
ciao

[Anthony47]

Questa dovrebbe essere piu' veloce:

Codice: Seleziona tutto

    Sub CopiaR()
    UR1 = Worksheets("Materie").Range("B" & Rows.Count).End(xlUp).Row
    UR2 = Worksheets("Domande").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("Domande").Select
    For RR2 = 2 To UR2
    RR1 = Application.WorksheetFunction.Match(Cells(RR2, 2).Value, Sheets("Materie").Range("B1:B" & UR1), False)
'    Cells(RR2, 3).Resize(1, 11).Clear
        Worksheets("Materie").Range("C" & RR1 & ":M" & RR1).Copy Destination:=Worksheets("Domande").Range("C" & RR2)
    Next RR2
    End Sub


Pero' sarebbe stato meglio continuare la discussione dove era cominciata:http://www.pc-facile.com/forum/viewtopic.php?f=26&t=92117

Ciao

[Statix]

Ciao Anthony47,
la macro va come una scheggia
scusami se non ho continuato nell' altro post,
grazie