http://www.filedropper.com/analisipupilfoglio1
ECCO QUA IL FILE
Moderatori: Anthony47, Flash30005
Flash30005 ha scritto:Avresti dovuto comprimere il file come archivio tipo .zip o .rar
ciao
Anthony47 ha scritto:Questa macro dovrebbe essere sostanzialmente piu' veloce della precedente:
- Codice: Seleziona tutto
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
Al momento considera, nel foglio di Output, max 5000 colonne di dati; se e' un problema si puo' inserire un controllo per allargare all'occorrenza il numero di colonne.
Non ho seguito la discussione, quindi non sono certo di aver realizzato quanto richiesto da pany221; insomma dovete fare un collaudo critico.
Ciao
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 |
Visitano il forum: Nessuno e 100 ospiti