Moderatori: Anthony47, Flash30005
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
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
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
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.
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
Flash30005 ha scritto:Prova questa macro
Ciao
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
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
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
Flash30005 ha scritto:Prova così
Ciao
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
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
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
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
Torna a Applicazioni Office Windows
Inserimento parziale valore cella in MessageBox Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 6 |
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Perchè l'importazione dati con Selenium non fuziona? Autore: aggittoriu |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 18 ospiti