Condividi:        

Inserimento dati in archivio.

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Inserimento dati in archivio.

Postdi ahidai » 24/01/12 17:34

Un ciao a tutti, ho un foglio1 con un elenco a discesa "37 numeri" in B9 vorrei che mi venissero trascritti in seguenza sul foglio2 da B2 in poi ogni volta che seleziono un numero.
Spero di essere stato chiaro e che si possa fare.
Grazie per le risposte.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Sponsor
 

Re: Inserimento dati in archivio.

Postdi ahidai » 24/01/12 21:20

Allora provato a registrare una macro:
Codice: Seleziona tutto
Sub copia()

    Sheets("Dati").Select
    Range("B9").Select
    Selection.Copy
    Sheets("Archivio").Select
    UR = Range("B" & Rows.Count).End(xlUp).Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Dati").Select
End Sub

Ma purtroppo non fa quello che vorrei, aiutoooo!!!!!
Allego file e grazie per le risposte.
http://www.filedropper.com/cartel1_1
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 25/01/12 00:45

Inserisci questo codice nel foglio1 (con la cella ad elenco a discesa)

Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
CheckArea = "B9"
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Then
    UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row + 1
    If UR < 9 Then UR = 9
    Worksheets("Foglio2").Range("B" & UR).Value = Target
    End If
End Sub


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi Anthony47 » 25/01/12 02:55

Mi permetto di suggerire questa versione semplificata.
Tasto dx sul tab col nome del foglio su cui lavori, scegli Visualizza codice; copia questo codice e incollalo nel frame vuoto di dx:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$B$9" Then Exit Sub
   Sheets("Foglio2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Target.Value
End Sub

Ciao a tutti.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Inserimento dati in archivio.

Postdi ahidai » 25/01/12 19:44

Anthony47 ha scritto:Mi permetto di suggerire questa versione semplificata.
Tasto dx sul tab col nome del foglio su cui lavori, scegli Visualizza codice; copia questo codice e incollalo nel frame vuoto di dx:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$B$9" Then Exit Sub
   Sheets("Foglio2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Target.Value
End Sub

Ciao a tutti.


Grazie Anthony è perfetta, se non ti dispiace e se hai un pò di tempo da "perdere" per me ti vorrei chiedere un'altra cosa, sempre se è possibile realizzarla.
Allora sul foglio2 dove vengono trascritti i numeri in sequenza, vorrei che in base alla tabella che ho ricopiata dalla roulette "orario e antiorario" nella colonna “D” mi scrivi la distanza tra i 2 numeri usciti e poi nella colonna “F” mi scriva se è “orario o antiorario”, forse è meglio che allego il file con degli esempi.
http://www.filedropper.com/cartel1_2
Comunque grazie ancora per la tua disponibilità.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi ahidai » 25/01/12 20:53

Riallego il file
http://www.mediafire.com/?aretc57za5jf8kp
Ciao a tutti.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 26/01/12 04:18

Prova questa macro

Codice: Seleziona tutto
Sub OrarioAnti()
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
Dim VettO(37) As Integer
VettO(1) = 32
VettO(2) = 15
VettO(3) = 19
VettO(4) = 4
VettO(5) = 21
VettO(6) = 2
VettO(7) = 25
VettO(8) = 17
VettO(9) = 34
VettO(10) = 6
VettO(11) = 27
VettO(12) = 13
VettO(13) = 36
VettO(14) = 11
VettO(15) = 30
VettO(16) = 8
VettO(17) = 23
VettO(18) = 10
VettO(19) = 5
VettO(20) = 24
VettO(21) = 16
VettO(22) = 33
VettO(23) = 1
VettO(24) = 20
VettO(25) = 14
VettO(26) = 31
VettO(27) = 9
VettO(28) = 22
VettO(29) = 18
VettO(30) = 29
VettO(31) = 7
VettO(32) = 28
VettO(33) = 12
VettO(34) = 35
VettO(35) = 3
VettO(36) = 26
VettO(37) = 0
For RR = 2 To UR - 1
    Num1 = Worksheets("Foglio2").Range("B" & RR).Value
    Num2 = Worksheets("Foglio2").Range("B" & RR + 1).Value
    ORiE = ""
For VN = 1 To 37
    If VettO(VN) = Num1 Then
        NI = VN
        If ORiE = "" Then ORiE = "ORARIO"
    End If
    If VettO(VN) = Num2 Then
        NF = VN
        If ORiE = "" Then ORiE = "ANTIORARIO"
    End If
Next VN
Worksheets("Foglio2").Range("D" & RR).Value = Abs(NI - NF) + 1
Worksheets("Foglio2").Range("F" & RR).Value = ORiE
Next RR
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi ahidai » 26/01/12 10:41

Flash30005 ha scritto:Prova questa macro

Ciao

Grazie Flash va benissimo e un grazie anche a Anthony siete grandi.....
Adesso la metterò in pratica cercando di non perdere tanti soldi :D .
Ciao
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi ahidai » 26/01/12 20:36

Ciao Flash, testando la macro purtroppo non fa esattamente quello che volevo, se cortesemente ci dai un'occhiata, le spiegazioni di cosa vorrei che facesse le ho scritte nel file.
Grazie ancora per la tua disponibilià. Ciao.
http://www.mediafire.com/?h9e6pg676brmenh
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 26/01/12 22:20

Si c'era un bug
sostituisci l'ultima parte dell macro (esclusa la dichiarazione Vettori)
Codice: Seleziona tutto
For RR = 2 To UR - 1
    Num1 = Worksheets("Foglio2").Range("B" & RR).Value
    Num2 = Worksheets("Foglio2").Range("B" & RR + 1).Value
    ORiE = ""
For VN = 1 To 37
    If VettO(VN) = Num1 Then
        NI = VN
        If ORiE = "" Then ORiE = "ORARIO"
    End If
    If VettO(VN) = Num2 Then
        NF = VN
        If ORiE = "" Then ORiE = "ANTIORARIO"
    End If
Next VN
If NF >= NI Then
    ValD = (NF - NI) + 1
Else
    ValD = 38 - (NI - NF)
End If
Worksheets("Foglio2").Range("D" & RR).Value = ValD
Worksheets("Foglio2").Range("F" & RR).Value = ORiE
Next RR
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi Anthony47 » 27/01/12 00:11

Per ahidai:
Per favore riporta nel prossimo messaggio la descrizione della richiesta, altrimenti la discussione qui diventa illegibile e tra qualche mese, quando l' allegato non sara' piu' accessibile, addirittura surreale.

Grazie.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Inserimento dati in archivio.

Postdi ahidai » 27/01/12 09:23

Ciao Flash e ciao Anthony.
Per Anthony, chiedo scusa, si in effetti non bisogna farne una questione “personale” ma del forum.
Allora, chiedevo nella macro di considerare la distanza minima che intercorre tra i 2 numeri sia che sia antiorario che orario, cioè nei numeri della roulette la distanza tra i numeri 12 e 17 doveva essere 13 “orario” e non 26 antiorario. La macro dovrebbe scegliere in automatico e trascrivere sul foglio2 la distanza minima tra gli ultimi 2 numeri usciti.
Per Flash, ho fatto la modifica che mi avevi suggerito, ma il risultato è lo stesso e cioè:
12 - 13 - antiorario “ma doveva essere orario”
17 - 24 - la distanza doveva essere 15 e non 24; antiorario e non orario;
7 - 13 - orario “ma doveva essere antiorario ”
2 - 28 - la distanza doveva essere 11 e non 28; antiorario e non orario;
12
Riporto la macro da me assemblata:
Codice: Seleziona tutto
Sub OrarioAnti()
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
Dim VettO(37) As Integer
VettO(1) = 32
VettO(2) = 15
VettO(3) = 19
VettO(4) = 4
VettO(5) = 21
VettO(6) = 2
VettO(7) = 25
VettO(8) = 17
VettO(9) = 34
VettO(10) = 6
VettO(11) = 27
VettO(12) = 13
VettO(13) = 36
VettO(14) = 11
VettO(15) = 30
VettO(16) = 8
VettO(17) = 23
VettO(18) = 10
VettO(19) = 5
VettO(20) = 24
VettO(21) = 16
VettO(22) = 33
VettO(23) = 1
VettO(24) = 20
VettO(25) = 14
VettO(26) = 31
VettO(27) = 9
VettO(28) = 22
VettO(29) = 18
VettO(30) = 29
VettO(31) = 7
VettO(32) = 28
VettO(33) = 12
VettO(34) = 35
VettO(35) = 3
VettO(36) = 26
VettO(37) = 0
For RR = 2 To UR - 1
    Num1 = Worksheets("Foglio2").Range("B" & RR).Value
    Num2 = Worksheets("Foglio2").Range("B" & RR + 1).Value
    ORiE = ""
For VN = 1 To 37
    If VettO(VN) = Num1 Then
        NI = VN
        If ORiE = "" Then ORiE = "ORARIO"
    End If
    If VettO(VN) = Num2 Then
        NF = VN
        If ORiE = "" Then ORiE = "ANTIORARIO"
    End If
Next VN
If NF >= NI Then
    ValD = (NF - NI) + 1
Else
    ValD = 38 - (NI - NF)
End If
Worksheets("Foglio2").Range("D" & RR).Value = ValD
Worksheets("Foglio2").Range("F" & RR).Value = ORiE
Next RR
End Sub

Ciao e grazie per la vostra pazienza.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 27/01/12 10:41

Prova così
Codice: Seleziona tutto
Sub OrarioAnti()
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
Dim VettO(74) As Integer
VettO(1) = 32
VettO(2) = 15
VettO(3) = 19
VettO(4) = 4
VettO(5) = 21
VettO(6) = 2
VettO(7) = 25
VettO(8) = 17
VettO(9) = 34
VettO(10) = 6
VettO(11) = 27
VettO(12) = 13
VettO(13) = 36
VettO(14) = 11
VettO(15) = 30
VettO(16) = 8
VettO(17) = 23
VettO(18) = 10
VettO(19) = 5
VettO(20) = 24
VettO(21) = 16
VettO(22) = 33
VettO(23) = 1
VettO(24) = 20
VettO(25) = 14
VettO(26) = 31
VettO(27) = 9
VettO(28) = 22
VettO(29) = 18
VettO(30) = 29
VettO(31) = 7
VettO(32) = 28
VettO(33) = 12
VettO(34) = 35
VettO(35) = 3
VettO(36) = 26
VettO(37) = 0
VettO(38) = 32
VettO(39) = 15
VettO(40) = 19
VettO(41) = 4
VettO(42) = 21
VettO(43) = 2
VettO(44) = 25
VettO(45) = 17
VettO(46) = 34
VettO(47) = 6
VettO(48) = 27
VettO(49) = 13
VettO(50) = 36
VettO(51) = 11
VettO(52) = 30
VettO(53) = 8
VettO(54) = 23
VettO(55) = 10
VettO(56) = 5
VettO(57) = 24
VettO(58) = 16
VettO(59) = 33
VettO(60) = 1
VettO(61) = 20
VettO(62) = 14
VettO(63) = 31
VettO(64) = 9
VettO(65) = 22
VettO(66) = 18
VettO(67) = 29
VettO(68) = 7
VettO(69) = 28
VettO(70) = 12
VettO(71) = 35
VettO(72) = 3
VettO(73) = 26
VettO(74) = 0
For RR = 2 To UR - 1
    Num1 = Worksheets("Foglio2").Range("B" & RR).Value
    Num2 = Worksheets("Foglio2").Range("B" & RR + 1).Value
    ORiE = ""
For VN = 1 To 37
    If VettO(VN) = Num1 Then
        NI = VN
        For VB = VN + 1 To 74
            If VettO(VB) = Num2 Then
                NF = VB
                GoTo esci
            End If
        Next VB
    End If
Next VN
esci:
ORiE = "ORARIO"
ValD = (NF - NI) + 1
If NF - NI >= 19 Then
    ValD = 38 + (NI - NF)
    ORiE = "ANTIORARIO"
End If
Worksheets("Foglio2").Range("D" & RR).Value = ValD
Worksheets("Foglio2").Range("F" & RR).Value = ORiE
Next RR
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi ahidai » 27/01/12 11:50

Flash30005 ha scritto:Prova così
Ciao

Ok Flash ti ringrazio, così è perfetta... ciao
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 27/01/12 19:31

Ho dovuto ripegare aggiungendo altri 37 vettori perché a forza di "ragionarci" sopra
(ragionarci per modo di dire perché ero cotto), non ne uscivo...

ma a mente fresca riporterò a 37 il numero dei vettori ;)

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi ahidai » 30/01/12 09:24

Flash30005 ha scritto:Ho dovuto ripegare aggiungendo altri 37 vettori perché a forza di "ragionarci" sopra
(ragionarci per modo di dire perché ero cotto), non ne uscivo...

ma a mente fresca riporterò a 37 il numero dei vettori ;)

ciao

Ciao Flash grazie di nuovo, comunque la sto testando e funziona benissimo.
Ciao
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Re: Inserimento dati in archivio.

Postdi Flash30005 » 30/01/12 14:19

Come promesso, ora ha molte meno righe"

Codice: Seleziona tutto
Sub OrarioAnti()
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
Dim VettO(74) As Integer
VettO(1) = 32
VettO(2) = 15
VettO(3) = 19
VettO(4) = 4
VettO(5) = 21
VettO(6) = 2
VettO(7) = 25
VettO(8) = 17
VettO(9) = 34
VettO(10) = 6
VettO(11) = 27
VettO(12) = 13
VettO(13) = 36
VettO(14) = 11
VettO(15) = 30
VettO(16) = 8
VettO(17) = 23
VettO(18) = 10
VettO(19) = 5
VettO(20) = 24
VettO(21) = 16
VettO(22) = 33
VettO(23) = 1
VettO(24) = 20
VettO(25) = 14
VettO(26) = 31
VettO(27) = 9
VettO(28) = 22
VettO(29) = 18
VettO(30) = 29
VettO(31) = 7
VettO(32) = 28
VettO(33) = 12
VettO(34) = 35
VettO(35) = 3
VettO(36) = 26
VettO(37) = 0
For RR = 2 To UR - 1
    Num1 = Worksheets("Foglio2").Range("B" & RR).Value
    Num2 = Worksheets("Foglio2").Range("B" & RR + 1).Value
    ORiE = ""
NI = -1
NF = -1
For VN = 1 To 37
    If VettO(VN) = Num1 Then
        If NI = -1 Then NI = VN
    End If
    If VettO(VN) = Num2 Then
        If NF = -1 Then NF = VN
    End If
Next VN
If NF - NI < 0 Then NF = 37 + Abs(NF)
esci:
ORiE = "ORARIO"
ValD = (NF - NI) + 1
If NF - NI >= 19 Then
    ValD = 38 + (NI - NF)
    ORiE = "ANTIORARIO"
End If
Worksheets("Foglio2").Range("D" & RR).Value = ValD
Worksheets("Foglio2").Range("F" & RR).Value = ORiE
Next RR
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Inserimento dati in archivio.

Postdi Anthony47 » 30/01/12 16:02

Fuori tempo masimo (?) pubblico una mia ipotesi di soluzione, ma non sono certo che il calcolo sia fatto secondo le regole appropriate; io ho usato quelle aritmetiche per cui con le estrazioni 7 e 7 la distanza e' "0".
Codice: Seleziona tutto
Sub myscost()
Dim Vetto As Variant
ColD = "D" '<<< Colonne in cui inserire distanza e Verso
ColV = "E" '<<<
'
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
'
Vetto = Array(0, 32, 15, 19, 4, 21, 2, 25, 17, 34, 6, 27, 13, 36, 11, 30, 8, 23, 10, _
        5, 24, 16, 33, 1, 20, 14, 31, 9, 22, 18, 29, 7, 28, 12, 35, 3, 26)
For I = 2 To UR - 1
    wDist = Abs(Application.Match(Cells(I, 2).Value, Vetto, 0) - _
        Application.Match(Cells(I + 1, 2).Value, Vetto, 0))
    If wDist > 18 Then
        Cells(I, ColD) = 37 - wDist: Cells(I, ColV) = "ORAR"
    ElseIf wDist < 18 And wDist > 0 Then Cells(I, ColD) = wDist: Cells(I, ColV) = "AntiORAR"
    Else: Cells(I, ColD) = 0: Cells(I, ColV) = ""
    End If
Next I
End Sub

Personalizza le due istruzioni marcate <<< e prova.

Ovviamente il risultato non quadra con quanto calcolato con la macro di Flash (vedi sopra)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Inserimento dati in archivio.

Postdi Anthony47 » 30/01/12 21:56

In attesa di altri commenti mi sono fatta questa modifica che rimedia a un errore di logica:
Codice: Seleziona tutto
Sub myscost1()
Dim VettO As Variant
ColD = "D" '<<< Colonne in cui inserire distanza e Verso
ColV = "E" '<<<
'
UR = Worksheets("Foglio2").Range("B" & Rows.Count).End(xlUp).Row
'
VettO = Array(0, 32, 15, 19, 4, 21, 2, 25, 17, 34, 6, 27, 13, 36, 11, 30, 8, 23, 10, _
        5, 24, 16, 33, 1, 20, 14, 31, 9, 22, 18, 29, 7, 28, 12, 35, 3, 26)
For I = 2 To UR - 1
    wDist = Abs(Application.Match(Cells(I, 2).Value, VettO, 0) - _
        Application.Match(Cells(I + 1, 2).Value, VettO, 0))
               
Select Case wDist
Case 19 To 40
Cells(I, ColD) = 37 - wDist: Cells(I, ColV) = "ORAR"
Case 1 To 18
Cells(I, ColD) = wDist: Cells(I, ColV) = "AntiORAR"
Case 0
Cells(I, ColD) = 0: Cells(I, ColV) = ""
End Select
Next I
End Sub

Per evitare di sconfondermi negli If /elseif ora uso Select Case :D

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Inserimento dati in archivio.

Postdi ahidai » 03/02/12 10:59

Ciao Flash e ciao Anthony, allora ho testato le ultime 2 macro, sembra che funzionano tutte e 2, l'unica differenza che ho notato è che se seleziono 2 numeri uguali consecutivamente, nella macro di Flash il risultato è 1 invece quella di Anthony il risultato è 0.
Quindi ho pensato che la macro di Flash cominca a contare compreso il numero uscito invece quella di Anthony comincia a contare dal numero successivo.
Inoltre devo verificare meglio "Orario e Antiorario" nella macro di Anthony.
Un grazie ad entrambi per la disponibiltà e buon fine settimana.
Ciao.
ahidai
Utente Senior
 
Post: 212
Iscritto il: 08/12/10 17:33

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Inserimento dati in archivio.":


Chi c’è in linea

Visitano il forum: Nessuno e 38 ospiti