Ciao...ti ringrazio davvero per il lavoro fatto!
C'è un piccolo problema...non riesco ad aprile il file che mi hai mandato, per via dell'estensione XLSM.
Non è che per caso riesci a mandarmelo con un'altra estensione?
Moderatori: Anthony47, Flash30005
Sub Trasponi()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet
Set Ws1 = Worksheets("Periodo di interesse")
Dim Ws2 As Worksheet
Set Ws2 = Worksheets("Analisi preliminari")
UR1 = Ws1.Cells(Rows.Count, 3).End(xlUp).Row
UC1 = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
UR2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
Ws2.Range("C3:XFD" & UR2).Clear
For RR2 = 3 To UR2
Rif = Ws2.Range("A" & RR2)
Conta = 1
For RR1 = 3 To UR1
If Ws1.Range("C" & RR1) = Rif Then
Ws2.Range("B1").Offset(RR2 - 1, Conta) = Ws1.Range("A1").Offset(RR1 - 1, UC1 - 1)
Conta = Conta + 1
End If
Next RR1
Next RR2
End Sub
Sub Trasponi3()
Dim myMatch, RR1 As Long, UR1 As Long, UR2 As Long, UC2 As Long, VArrIn, VArrAH, ArrOut(), MArea As Range
Dim Conta As Long, mConta As Long
'
mytim = Timer
Application.ScreenUpdating = False
Dim Ws1 As Worksheet
Set Ws1 = Worksheets("Periodo di interesse")
Dim Ws2 As Worksheet
Set Ws2 = Worksheets("Analisi preliminari")
UR1 = Ws1.Cells(Rows.Count, 3).End(xlUp).Row
UC1 = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
UR2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
'
ReDim ArrOut(3 To UR2, 1 To 5000)
VArrIn = Ws1.Range("C3").Resize(UR1 + 2, 1).Value
VArrAH = Ws1.Range("AH3").Resize(UR1 + 2, 1).Value
'
Ws2.Range("C3:XFD" & UR2).Clear
Set MArea = Ws2.Range("A1").Resize(UR2 + 5, 1)
Conta = 1
For RR1 = LBound(VArrIn, 1) To UBound(VArrIn, 1) - 1
'DoEvents
myMatch = Application.Match(VArrIn(RR1, 1), MArea, False)
If Not IsError(myMatch) Then
ArrOut(myMatch, Conta) = VArrAH(RR1, 1)
If VArrIn(RR1, 1) <> VArrIn(RR1 + 1, 1) Then Conta = 1 Else Conta = Conta + 1
If Conta > mConta Then mConta = Conta
End If
Next RR1
Ws2.Range("C3").Resize(UR2, mConta).Value = ArrOut
Application.ScreenUpdating = True
MsgBox ("Completato in (Sec): " & Format(Timer - mytim, "0.00"))
End Sub
Torna a Applicazioni Office Windows
Inserimento dati su tabella da codice a barre Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 80 |
Ricavare dati di origine di un grafico online Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 19 |
Sempre su Autohotkey...importare dati e copiarli in file.txt Autore: Paolo67met |
Forum: Programmazione Risposte: 27 |
Visitano il forum: Nessuno e 37 ospiti