| | Post: 397 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
  05/05/2017 12:10 | |
Buongiorno,
che bello vedere un forum che cresce
ne ho fatte di richieste e tutte esaudite
ritorno qui per capire , se possibile, effettuare
una routine di trasposizione di alcuni dati
allego screen
il blocco di dati non e' regolare
a volte da 8 a volte da 7 ecc ecc
unico riferimento certo 1 - 0,00 - 1 per eventuali differenze
per trasposizione con credo un ciclo for next.
Ringrazio in anticipo eventuali suggerimenti/consigli per costruirlo insieme
0 0 0 1 -11,89 728,59 1 0 730,199
117+740.00 0 0 2 -9,80 729,98 2 0 729,008
0 0 0 3 -8,80 729,94 0
0 0 0 4 -7,00 729,99 0
0 0 0 5 0,00 730,20 0
0 0 0 6 0,60 730,22 0
0 0 0 7 0,60 730,22 0
0 0 0 8 2,10 730,16 0
1 1 1 1 -11,97 727,57 1 0 729,228
117+760.00 0 1 2 -9,80 729,01 2 0 728,297
0 0 1 3 -8,80 728,96 0
0 0 1 4 -7,00 729,02 0
0 0 1 5 0,00 729,23 0
0 0 1 6 0,60 729,25 0
0 0 1 7 2,10 729,19 0
2 2 2 1 -11,36 727,00 1 0 728,255
117+780.00 0 2 2 -9,80 728,04 2 0 727,546
0 0 2 3 -8,80 727,99 0
0 0 2 4 -7,00 728,05 0
0 0 2 5 0,00 728,26 0
0 0 2 6 0,60 728,27 0
0 0 2 7 0,60 728,27 0
0 0 2 8 2,10 728,21 0
3 3 3 1 -9,87 727,00 1 0 727,264
117+800.00 0 3 2 -9,80 727,05 2 0 726,819
0 0 3 3 0,00 727,26 0
0 0 3 4 0,60 727,28 0
0 0 3 5 0,60 727,28 0
0 0 3 6 2,10 727,22 0
4 4 4 1 -9,80 726,04 1 0 726,253
117+820.00 0 4 2 0,00 726,25 0 726,109
0 0 4 3 0,60 726,27 0
0 0 4 4 0,60 726,27 0
0 0 4 5 2,10 726,21 0
5 5 5 1 -10,91 726,13 1 0 725,237
117+840.00 0 5 2 -9,80 725,02 2 0 725,018
0 0 5 3 -8,80 724,97 0
0 0 5 4 -7,00 725,03 0
0 0 5 5 0,00 725,24 0
0 0 5 6 0,60 725,26 0
0 0 5 7 0,60 725,26 0
0 0 5 8 2,10 725,20 0
6 6 6 1 -10,76 724,97 1 0 724,221
[Modificato da Mat71 05/05/2017 12:11]
------------------------
 |
|
| | Post: 397 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
| 05/05/2017 14:38 | |
Con questa macro sono riuscito ad uniformare tutte le righe
a gruppi di 8
Sub PP()
Application.ScreenUpdating = False
For conta = 3 To 7
For uriga = 2 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(uriga, 4) = 1 And Cells(uriga - 1, 4) = conta Then
Cells(uriga, 4).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(uriga, 4).Value = conta + 1
End If
Next
Next
Application.ScreenUpdating = True
End Subb
ora il problema e' trasporre partendo da 0,00 inserendo i valori negativi a sx mentre quelli positivi a Dx incolonnando lo 0,00
ci studio ... :( [Modificato da Mat71 05/05/2017 14:39]
------------------------
|
| | Post: 3.847 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
| 05/05/2017 15:39 | |
ormai dovresti sapere che sono graditi i file di esempio e non le immagini
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 398 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
| 05/05/2017 16:47 | |
Ciao Patel45
Hai perfettamente ragione ...
------------------------
|
| | Post: 399 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
| 05/05/2017 18:34 | |
Andrebbe migliorata ... :(
Sub PP()
Application.ScreenUpdating = False
For conta = 3 To 9
For uriga = 2 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(uriga, 4) = 1 And Cells(uriga - 1, 4) = conta Then
Cells(uriga, 4).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(uriga, 4).Value = conta + 1
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Sub confronta()
Application.ScreenUpdating = False
PP
LR = Cells(Rows.Count, "D").End(xlUp).Row
a = 0
For r = 5 To LR
If Cells(r, 5) = "0" Then
'Cells(a + 1, 11).Value = Cells(r, 1).Value
'Cells(a + 1, 12).Value = Cells(r - 1, 1).Value
Cells(a + 1, 13).Value = Cells(r - 4, 5).Value
Cells(a + 1, 14).Value = Cells(r - 4, 6).Value
Cells(a + 1, 15).Value = Cells(r - 3, 5).Value
Cells(a + 1, 16).Value = Cells(r - 3, 6).Value
Cells(a + 1, 17).Value = Cells(r - 2, 5).Value
Cells(a + 1, 18).Value = Cells(r - 2, 6).Value
Cells(a + 1, 19).Value = Cells(r - 1, 5).Value
Cells(a + 1, 20).Value = Cells(r - 1, 6).Value
Cells(a + 1, 21).Value = Cells(r, 5).Value
Cells(a + 1, 22).Value = Cells(r, 6).Value
'Cells(a + 1, 23).Value = Cells(r, 9).Value
Cells(a + 1, 24).Value = Cells(r + 1, 5).Value
Cells(a + 1, 25).Value = Cells(r + 1, 6).Value
Cells(a + 1, 26).Value = Cells(r + 2, 5).Value
Cells(a + 1, 27).Value = Cells(r + 2, 6).Value
Cells(a + 1, 28).Value = Cells(r + 3, 5).Value
Cells(a + 1, 29).Value = Cells(r + 3, 6).Value
Cells(a + 1, 30).Value = Cells(r + 4, 5).Value
Cells(a + 1, 31).Value = Cells(r + 4, 6).Value
a = a + 1
'MsgBox "colonne uguali"
End If
Next
confronta1
End Sub
Sub confronta1()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "D").End(xlUp).Row
a = 0
For r = 5 To LR
If Cells(r, 4) = 1 Then
Cells(a + 1, 11).Value = Cells(r + 1, 1).Value
Cells(a + 1, 12).Value = Cells(r, 1).Value
Cells(a + 1, 23).Value = Cells(r + 1, 9).Value
a = a + 1
'MsgBox "colonne uguali"
End If
Next
End Sub
------------------------
|
| | Post: 3.848 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
| 05/05/2017 18:50 | |
ora dovresti spiegare con quale criterio fare la trasposizione
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 400 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
| 08/05/2017 08:47 | |
E' una trasposizione strana una parte dei
dati negativi a sinistra mentre quelli positivi a destra
partendo dallo 0,00
[Modificato da Mat71 08/05/2017 08:48]
------------------------
|
| | Post: 401 | Registrato il: 02/02/2006
| Città: ROMA | Età: 52 | Utente Senior | 2007 | | OFFLINE |
|
| 08/05/2017 09:25 | |
... diciamo che modificando la mia macro ci sono riusciro
Sub PP()
Application.ScreenUpdating = False
For xriga = 2 To Cells(Rows.Count, "D").End(xlUp).Row + 1
If Cells(xriga, 4) = 1 And Cells(xriga, 5) = 0 Then
Cells(xriga, 5).Value = 0.01
End If
Next
For conta = 3 To 10
For uriga = 2 To Cells(Rows.Count, "D").End(xlUp).Row + 1
If Cells(uriga, 4) = 1 And Cells(uriga - 1, 4) = conta Then
Cells(uriga, 4).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(uriga, 4).Value = conta + 1
End If
Next
Next
Range("A1:I5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Sub confronta()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "D").End(xlUp).Row
a = 0
For r = 5 To LR
If Cells(r, 5) = "0" Then
'Cells(a + 1, 11).Value = Cells(r, 1).Value
'Cells(a + 1, 12).Value = Cells(r - 1, 1).Value
Cells(a + 1, 13).Value = Cells(r - 4, 5).Value
Cells(a + 1, 14).Value = Cells(r - 4, 6).Value
Cells(a + 1, 15).Value = Cells(r - 3, 5).Value
Cells(a + 1, 16).Value = Cells(r - 3, 6).Value
Cells(a + 1, 17).Value = Cells(r - 2, 5).Value
Cells(a + 1, 18).Value = Cells(r - 2, 6).Value
Cells(a + 1, 19).Value = Cells(r - 1, 5).Value
Cells(a + 1, 20).Value = Cells(r - 1, 6).Value
Cells(a + 1, 21).Value = Cells(r, 5).Value
Cells(a + 1, 22).Value = Cells(r, 6).Value
'Cells(a + 1, 23).Value = Cells(r, 9).Value
Cells(a + 1, 24).Value = Cells(r + 1, 5).Value
Cells(a + 1, 25).Value = Cells(r + 1, 6).Value
Cells(a + 1, 26).Value = Cells(r + 2, 5).Value
Cells(a + 1, 27).Value = Cells(r + 2, 6).Value
Cells(a + 1, 28).Value = Cells(r + 3, 5).Value
Cells(a + 1, 29).Value = Cells(r + 3, 6).Value
Cells(a + 1, 30).Value = Cells(r + 4, 5).Value
Cells(a + 1, 31).Value = Cells(r + 4, 6).Value
a = a + 1
'MsgBox "colonne uguali"
End If
Next
confronta1
End Sub sicuramente migliorabile dai piu' esperti ...
------------------------
|
|
|
|
|