Salve Flash,
pare che tutto va bene anzi OK
Eventualmente ti faro sapere.
Ti posso dire una cosa? sei
Moderatori: Anthony47, Flash30005
Sub Analisi()
Set Ws1 = Worksheets("Ambi")
Set Ws2 = Worksheets("AnalisiA")
Ws2.Cells.ClearContents
For CC = 1 To 2
For RR = 1 To 12
Riga2 = Ws1.Cells(RR, CC).Value
Ws2.Cells(Riga2, 1).Value = Riga2
UC2 = Ws2.Cells(Riga2, 255).End(xlToLeft).Column + 1
If CC = 1 Then
Ws2.Cells(Riga2, UC2).Value = Ws1.Cells(RR, CC + 1).Value
Else
Ws2.Cells(Riga2, UC2).Value = Ws1.Cells(RR, CC - 1).Value
End If
Next RR
Next CC
End Sub
Sub CreaAmbiS()
Riga = 0
For A1 = 1 To 89
For A2 = 1 To 90
Riga = Riga + 1
Cells(Riga, 1).Value = A1
Cells(Riga, 2).Value = A2
Next A2
Next A1
End Sub
=MAX(E1:E8010)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "S2:S11"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
Col = Target
Call OrdinaFreqA
End If
End Sub
Sub TrovaTA()
[T1] = Int(Timer)
Set Ws1 = Sheets("Archivio")
Set Ws2 = Sheets("AbbTA")
Application.EnableEvents = False
Ws2.Range("U1:V1").ClearContents
OrdinaAA
Ws2.Columns("E:N").ClearContents
Application.Calculation = xlManual
Application.ScreenUpdating = False
UR1 = Ws1.Range("C" & Rows.Count).End(xlUp).Row + 1
UR2 = Ws2.Range("O" & Rows.Count).End(xlUp).Row
For RR2 = 2 To UR2
NT1 = Ws2.Range("O" & RR2).Value
NT2 = Ws2.Range("P" & RR2).Value
NT3 = Ws2.Range("Q" & RR2).Value
With Ws1.Range("C2:V" & UR1)
Set C = .Find(NT1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
RC1 = C.Row
CC1 = C.Column
Call ConfrT
Do
Set C = .FindNext(C)
If firstAddress = C.Address Then Exit Do
RC1 = C.Row
CC1 = C.Column
Call ConfrT
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Next RR2
[U1] = Int(Timer)
[V1] = [U1] - [T1]
OrdinaFreqA
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub ConfrT()
UC = 21
For CC2 = CC1 + 1 To UC
If NT2 = Ws1.Cells(RC1, CC2).Value Then
For CC3 = CC2 + 1 To 22
If NT3 = Ws1.Cells(RC1, CC3).Value Then
For CCA = 3 To 21
AA1 = Ws1.Cells(RC1, CCA).Value
If AA1 = NT1 Or AA1 = NT2 Or AA1 = NT3 Then GoTo SaltaCCA
For CCB = CCA + 1 To 22
AA2 = Ws1.Cells(RC1, CCB).Value
If AA2 = NT1 Or AA2 = NT2 Or AA2 = NT3 Then GoTo SaltaCCB
RA = (AA1 - 1) * 90 + AA2
Ws2.Cells(RA, RR2 + 3).Value = Ws2.Cells(RA, RR2 + 3).Value + 1
SaltaCCB:
Next CCB
SaltaCCA:
Next CCA
End If
Next CC3
End If
Next CC2
End Sub
Sub OrdinaFreqA()
If Col = "" Then Col = "E"
Columns("A:N").Sort Key1:=Range(Col & "1"), Order1:=xlDescending, Key2:=Range("A1") _
, Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
End Sub
Sub OrdinaAA()
Columns("A:N").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
End Sub
Torna a Applicazioni Office Windows
windows 10 connessione wi-fi lenta con frequenti disconnesio Autore: Robmi |
Forum: Sistemi Operativi Windows Risposte: 4 |
Avira: scansioni frequenti non impostate Autore: marco ballotta |
Forum: Sicurezza e Privacy Risposte: 1 |
Disconnessioni casuali, frequenti ed estremamente irritanti Autore: Candelazzi |
Forum: Reti, ADSL e wireless Risposte: 10 |
Visitano il forum: Nessuno e 24 ospiti