|
| Precedente :: Successivo |
| Autore |
Messaggio |
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
 Inviato: 21 Ott 2005 14:30 Oggetto: * Ordinamento crescente/discendente di tabelle word |
 |
|
Salve, io ho un problema ad ottenere un ordine cronologico crescente o discendente di caselle di testo numerate. Word le ordina in questo modo: 1, 10, 100 ecc. - 2, 20, 200 ecc. - 3, 30... e cosi via.
Che sse po' ffa'? 
grazie
Paolo |
|
| Top |
|
 |
Lorenzo
Eroe in grazia degli dei
Registrato: 25/08/05 12:53
Messaggi: 105
|
| Inviato: 21 Ott 2005 15:17 Oggetto: |
|
|
Prova a numerarle invece di 1, 2, 3 ecc in 001, 002, 003 ecc.
In questo modo le numeri giuste
Ciao |
|
| Top |
|
|
Lorenzo
Eroe in grazia degli dei
Registrato: 25/08/05 12:53
Messaggi: 105
|
| Inviato: 21 Ott 2005 15:20 Oggetto: |
|
|
dimenticavo...
ovviamente poi scrivi 010, 011 ecc, 020, 021, ecc.
ovvio che così ordini fino a 999.
se vuoi ordinare con numeri a 4 o a 5 cifre parti da 0001 oppure 00001.
Ciao |
|
| Top |
|
|
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
| Inviato: 21 Ott 2005 17:19 Oggetto: grazie |
|
|
grazie, Lorenzo, ma non fa al caso mio: ho bisogno di lasciare la numerazione senza zeri avanti e, se non fossero passati diversi anni, mi ricorderei come avevo fatto quella volta che avevo risolto il problema! (in altre parole, si invecchia!)
Grazie lo stesso |
|
| Top |
|
|
ioSOLOio
Amministratore
Registrato: 12/09/03 19:01
Messaggi: 16342
Residenza: in un sacco di...acqua
|
| Inviato: 21 Ott 2005 17:52 Oggetto: |
|
|
non so esattamente come è fatta la tua pagina..
per prova ho creato una colonna con diverse celle..in ognuna ho scritto numeri a caso [ad esempio 1, 3, 7, 2, 10, 20, 5...] quindi la seleziono , dalla barra di Word scelgo Tabella -> Ordina imposto la colonna, numero e l'ordine (crescente o decrescente) e ottengo la colonna con le celle contenenti i numeri correttamente ordinati |
|
| Top |
|
|
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
| Inviato: 22 Ott 2005 09:07 Oggetto: |
|
|
Grazie, ma purtroppo il mio problema e' un po piu' complicato: ho un catalogo di oggetti classificati con lettere seguite da numeri. Esempio: A-1, A-2, A-110, A-111-7 e poi via di seguito con le altre lettere e numeri.
Word me le ordina cosi: A-1, A-110, A-111-7, A-2. Come faccio ad impostare l'ordinamento "logico"? Questa e' la mia domanda.
Grazie a tutti
Paolo |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 22 Ott 2005 17:25 Oggetto: |
|
|
Mi sembra che la soluzione sia di difficile realizzazione, non impossibile ma complessa.
Mi spiego meglio:
il fatto che le celle contengano dei riferimenti alfanumerici "imbroglia" l'ordinatore.
Gli algoritmi di ordinamento sul testo "si fermano" al primo carattere disuguale e posizionano la riga in modo coerente.
La prima cosa che mi viene in mente è la normalizzazione dei dati che deve avvenire in più passaggi:
| Codice: | .1 analisi delle chiavi di riga con suddivisione in sottostringhe
(usando il trattino come separatore)
.2 rilevazione del numero massimo di sottostringhe
.3 per ognuna delle colonne di sottostringhe:
3.1 rilevazione della sottostringa più "lunga"
3.2 normalizzazione delle sottostringhe più "corte"
con riempimento del carattere spazio a sinistra
(se presenti A-1 e A-10, allora A-1 diventa A- 1)
.4 costruzione di una chiave temporanea (in aggiunta alla riga)che abbia il numero di caratteri pari a:
N-max_sottostrighe * N-max_caratteri_colonna_sottostringa
là dove in numero di sottostringhe fosse minore del max rilevato,
aggiungere una sottostringa di tutti spazi anteponendo un trattino
.5 ordinamento sulla chiave temporanea
.6 ricostruzione tabella con eliminazione della chiave temporanea
NB trattandosi di una chiave di ordinamento temporanea,
si possono usare gli zeri anzichè gli spazi |
Usando del codice non è complicato (penso 4 ore max), certo occorre conoscere VBA.
La cosa più agevole sarebbe utilizzare Excel come transito in cui le matrici (fogli con celle) sono di facile utilizzo. |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 23 Ott 2005 16:13 Oggetto: |
|
|
@torchiemana
Se t'interessa e mi dai un recapito, ti posso inviare il foglio di excel
con il codice necessario che esegue i passi sopracitati.
(è stato troppo divertente svilupparlo)
@ Tutti
PS. lo stesso foglio è disponibile per chi volesse richiedermelo....  8) |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 23 Ott 2005 17:29 Oggetto: |
|
|
Meglio..... posto qui il codice che ho scritto
| Codice: | Sub Passi_Ordinamento()
'* definizioni -----------------------------------------------
Dim CurrentWS As Worksheet 'foglio contenente la tabella
Dim TempWS As Worksheet 'foglio per matrice di transito
Dim Temp1WS As Worksheet 'foglio per matrice di transito
Dim sArgFrom As String 'argomento chiave da eaminare
Dim sKeyOrd As String 'chiave di ordinamento
Dim sCont As String 'debug
Dim avMaxLen As Variant 'matrice di lunghezze massime per ogni livello
Dim avTmp As Variant 'matrice temporanea per suddivisione in substringhe
Dim iLivelli As Integer 'numero massimo di livelli generale
Dim iLivRiga As Integer 'numero massimo di livelli per riga
Dim l As Integer 'indice di scansione livelli (substringhe)
Dim c As Integer 'indice di scansione colonne di substringhe
Dim r As Long 'indice di scansione righe
'* -----------------------------------------------------------
'* impostazioni iniziali -------------------------------------
Set CurrentWS = Worksheets("Foglio1")
Set TempWS = Worksheets("Foglio2")
Set Temp1WS = Worksheets("Foglio3")
iLivelli = -1
'* -----------------------------------------------------------
'************************************************************
'* PRIMO PASSO *
'*----------------------------------------------------------*
'* analisi della tabella *
'************************************************************
With CurrentWS
'*debug----------
' sCont = ""
'*---------------
'* ciclo di scansione fino alla prima cella vuota
For r = 1 To .Rows.Count
'* preleva contenuto
sArgFrom = .Cells(r, 2)
If Len(Trim(sArgFrom)) = 0 Then
'* termina ciclo
Exit For
End If
'* suddivide in substringhe
avTmp = Split(sArgFrom, "-")
If UBound(avTmp) > iLivelli Then
'* memo il numero massimo di livelli
iLivelli = UBound(avTmp) + 1
End If
'* ciclo di scrittura matrice di substringhe
'* memorizza a partire dal secondo elemento
'* nel primo il numero di livelli
For l = 0 To UBound(avTmp)
TempWS.Cells(r, l + 2) = avTmp(l)
Next
TempWS.Cells(r, 1) = l
'*debug -----------------------
' sCont = sCont _
' & .Cells(r, 2).Text _
' & vbLf
'*-----------------------------
Next
'*debug-----------------------------
' MsgBox sCont _
' & String(3, vbLf) _
' & "totale righe = " & r - 1 _
' & String(3, vbLf) _
' & "max Livelli = " & iLivelli
'*----------------------------------
End With
'************************************************************
'************************************************************
'* SECONDO PASSO *
'*----------------------------------------------------------*
'* analisi della matrice di substringhe *
'************************************************************
With TempWS
'* dimensiona la matrice(interna)
'* per la lunghezza max di ogni colonna
ReDim avMaxLen(iLivelli - 1)
'* ciclo di scansione per stabilire la lunghezza max
'* di ogni colonna di substringhe
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = Int(.Cells(r, 1))
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
If Len(sArgFrom) > avMaxLen(c - 2) Then
'*memo la lunghezza maggiore
avMaxLen(c - 2) = Len(sArgFrom)
End If
Next
Next
End With
'************************************************************
'************************************************************
'* TERZO PASSO *
'*----------------------------------------------------------*
'* normalizzazione delle substringhe *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
If Len(sArgFrom) < avMaxLen(c - 2) Then
'* normalizza con spazi a sinistra
'* (nella seconda matrice di transito)
Temp1WS.Cells(r, c - 1) = Space(avMaxLen(c - 2) - Len(sArgFrom)) _
& sArgFrom
Else
Temp1WS.Cells(r, c - 1) = sArgFrom
End If
Next
Next
End With
'************************************************************
'************************************************************
'* QUARTO PASSO *
'*----------------------------------------------------------*
'* composizione della chiave di ordinamento *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
sKeyOrd = ""
'* ciclo di scansione substringhe di riga
For c = 2 To iLivelli + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
'* imposta la proprietà testo per la cella
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
If Len(sArgFrom) = 0 Then
'* normalizza con tutti spazi livelli vuoti
Temp1WS.Cells(r, c - 1) = Space(avMaxLen(c - 2))
End If
sKeyOrd = sKeyOrd _
& Temp1WS.Cells(r, c - 1) _
& IIf((c - 1) = 1 Or (c - 1) = iLivelli, "", "-")
Next
'* debug ------------------------
' Debug.Print "<"; sKeyOrd; ">"
'* ------------------------------
'* memo chiave temporanea di ordinamento
CurrentWS.Cells(r, 1).NumberFormat = "@"
CurrentWS.Cells(r, 1) = sKeyOrd
Next
End With
'************************************************************
'************************************************************
'* QUINTO PASSO *
'*----------------------------------------------------------*
'* ordinamento *
'************************************************************
CurrentWS.Rows("1:" & r - 1).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'************************************************************
End
End Sub |
per eseguirlo:
.1 aprire il documento di Word che contiene la tabella
.2 aprire una nuova cartella di Excel
.3 incollare la macro qui sopra descritta
.4 copiare la tabella di Word senza intestazione
.5 incollarla in B1 del Foglio1
.6 eseguire la macro
.7 copiare le celle, a partire da B1
.8 incollarle nella tabella di Word
et voilà....... |
|
| Top |
|
|
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
| Inviato: 23 Ott 2005 18:16 Oggetto: |
|
|
| GrayWolf ha scritto: | | Mi sembra che la soluzione sia di difficile realizzazione, non impossibile ma complessa. |
Intuivo la complessita' del problema... me lo hai confermato. Hai fatto un lavoro eccezionale, lo mettero in pratica quanto prima e ti farò sapere. GRAZIE! |
|
| Top |
|
|
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
| Inviato: 24 Ott 2005 10:04 Oggetto: |
|
|
@ GrayWolf
Eccomi, ho provato a seguire le istruzioni: non ho capito "et voilà"!
In altre parole, non sono riuscito nell'intento!
Ho aperto la tabella word;
ho aperto excel ed ho incollato il programma che mi hai fornito, togliendo le parti descrittive (quelle tra le due file di asterischi);
ho incollato la tabella di word in B1 dello stesso foglio;
NON sono capace di eseguire la macro;
e mi sono fermato qui - Help!
Ti allego la tabella incriminata e ti ringrazio per la tua pazienza!
A-1
A-110
A-110-7
A-111
A-111-2
A-2
A-210
A-220
A-222
A-30
A-300-1-2
A-301
A-301-5002
A-301-5012
A-302
A-302-1
A-302-1000
A-302-1001
A-302-1004
A-302-1004-1
A-302-1004-2
A-302-2
A-302-2100-1
A-302-3
A-302-3001
A-302-3001-2
A-302-9999
A-303
A-304
A-305-11-2
A-306-6000
A-307
A-308
A-308-8000
A-310
A-311
A-315
A-316
A-319
A-400-2
A-400-4-1
A-501
A-601-2-1
A-602-1
A-604-1005
A-803
B
B-0-2
B-1
B-1-4
B-2
B-201
B-210
B-300
C-101
C-1-2
C-1-3
C-1-4
C-1-5
C-201
C-203
C-3
C-4
C-5
C-5-1
C-5-1-2
C-6
D-1
D-1-0
D-1-0
D-100
D-100-000
D-100-001
D-100-002
D-100-003
D-100-003 Q.F.
D-100-004
D-100-011
D-100-013
D-100-014
D-101
D-101-0100-2
D-101-1000
D-101-9100-1
D-104
D-1-1
D-110-2
D-110-2-0
D-110-2-1
D-111
D-111-1
D-111-1-11-2
D-111-1-11-4
D-112
D-113
D-113-1
D-114
D-114-1
D-114-2
D-116
D-117-4-0100
D-117-7
D-119-2
D-119-3
D-120
D-121
D-125
D-1-3
D-130
D-1-4
D-140
D-140-10
D-140-12
D-140-50
D-150
D-150-10
D-150-100
D-150-10-6
D-150-13
D-150-13-10
D-150-13-12
D-150-13-17
D-150-13-2
D-150-13-3
D-150-13-4
D-150-13-7
D-150-13-9
D-150-15
D-150-15
D-150-20
D-150-200
D-150-300-1
D-150-300-1-1
D-150-30-1
D-150-30-2
D-150-30-7
D-150-30-8
D-2
D-2-0
D-200-0
D-200-0200-0
D-200-0200-0
D-200-FARN
D-200-FARN-3
D-200-FARN-4
D-200-FARN-4
D-200-FARN-7
D-200-MADA
D-201
D-201-7
D-201-F8
D-201-FARN-CO
D-201-FARN-E3
D-201-FARN-F0
D-201-FARN-F4
D-202
D-2-0-3
D-2-0-4
D-210
D-2-10
D-211-0
D-212
D-213
D-2-4
D-2-6
D-3
D-30
D-303
D-304
D-304-RD
D-305
D-305-1-2
D-305-2
D-305-5
D-305-5-1
D-310-1
D-40
D-400
D-400-1
D-400-1-0
D-400-2
D-400-4
D-401
D-403-1
D-403-1-0
D-403-1-2
D-403-2-1
D-403-2-6
D-404
D-404-1
D-404-3
D-405-A4
D-50
D-500
D-500-1-0
D-500-1000
D-500-2000
D-501
D-501-1004
D-600
D-600-4
D-700
D-700-2
D-701
D-701-2001-3
D-702-2
D-702-4
E-100
E-10-11
E-103-0
E-103-100
E-10-5
E-10-5-4
E-15
E-15-3
E-16
E-21
E-21-3
E-230
E-232
E-235
E-244
E-246-1-4
E-3
E-300
E-300-4-2
E-300-4-3
E-501
E-6
F.0.7-1000
F-0-1
F-0-7-1000
F-1-PG
F-1-UAMA
F-2
F-200-1
F-203-23
F-204
F-3
F-301
F-309
F-4
F-400
F-401
F-402
F-411-7
F-413-1-7
F-450-3
F-450-6
F-450-6-PARM
G-0
G-001
G-004-2
G-005
G-005-4
G-006
G-007
G-008-3
G-011-6
G-020
G-0-2-0
G-025-5-3
G-028
G-0-3-3
G-035
G-0-3-5
G-036
G-5-6
G-9.2
G-900
G-901
G-9-1
G-9-2
H-1
H-106
H-107
H-108
H-200
H-300
H-300-9-1
H-5+5
H-50
J-100
J-100-3
J-100-4
J-101-2
J-101
J-102
J-103
J-104
J-106
J-110
J-111
J-120
J-120-0
J-120-KJ03-1
J-130
J-133
J-133-UC
J-150
J-150-20
J-150-2-1
J-201
J-300
K-5-1
K-7
K-7-KE21
K-9
K-A
K-B1
K-B-300-9
K-D1
K-D1-101
K-E
K-E-100
K-E-114
K-E21
K-E-322
K-E33
K-E-370-2
K-E-650
K-F2-1
K-G1-106
K-K-10
K-L5
L-1
L-2
L-3
L-3-C0
L-3-F0
L-3-K0
L-3-M
L-4
L-4-7
L-5
L-5-1
L-5-2
L-5-2-0
L-5-2-1
L-5-2-4
L-5-3-1
L-5-3-2
L-5-3-4
L-5-4
L-5-6
L-6
L-6-1000
L-6-1017
L-6-1019
L-6-1030
L-6-4000-2
L-7
L-7-10
L-7-3
L-7-3-1
L-7-7
L-8
L-8-B11
L-8-B16
L-8-D0
M-10
M-110
M-112
M-200
M-2-1
M-400-1
N-100
N-100-6-RAI
N-200
N-401-2
N-5-0
N-505
Grazie! |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 14:17 Oggetto: |
|
|
| torchiemana ha scritto: | @ GrayWolf
In altre parole, non sono riuscito nell'intento!
Ho aperto la tabella word;
ho aperto excel ed ho incollato il programma che mi hai fornito, togliendo le parti descrittive (quelle tra le due file di asterischi);
ho incollato la tabella di word in B1 dello stesso foglio;
NON sono capace di eseguire la macro;
e mi sono fermato qui - Help!
|
dunque....
la colpa è mia.... mi sono spiegato male....
apri il foglio di excel
vai al menu strumenti
scegli macro -->macro
digita xxx
scegli nel combo in basso "questa cartella di lavoro"
premi il pulsante Crea
a questo punto ti appare un form bianco con scritto
| Codice: | Sub xxx()
End Sub |
selezioni le tre righe
le sostituisci con :
| Codice: | Sub Passi_Ordinamento()
'**********************************************************
'* nota del 24.10.2005-1.01 (dopo il rilascio sul forum) *
'*--------------------------------------------------------*
'* nel caso in cui il riferimento alfabetico *
'* sia composto da più di una lettera, occorre *
'* richiedere l'autorizzazione a normalizzare *
'* anche tale riferimento. *
'* l'attuale struttura ordina nello stesso modo *
'* in cui excel denomina le colonne: A-Z; AA-AZ;BA-BZ.... *
'*--------------------------------------------------------*
'* SENZA la normalizzazione della parte alfabetica *
'* (vedi richiesta ed eccezione nella normalizzazione) *
'* l'ordinamento avviene elencando prima tutte le chiavi *
'* con radice A poi quelle con radice B e così via.... *
'**********************************************************
'* definizioni -----------------------------------------------
Dim CurrentWS As Worksheet 'foglio contenente la tabella
Dim TempWS As Worksheet 'foglio per matrice di transito
Dim Temp1WS As Worksheet 'foglio per matrice di transito
Dim sArgFrom As String 'argomento chiave da eaminare
Dim sKeyOrd As String 'chiave di ordinamento
Dim sCont As String 'debug
Dim sMsg As String 'generico: testo del messaggio
Dim avMaxLen As Variant 'matrice di lunghezze massime per ogni livello
Dim avTmp As Variant 'matrice temporanea per suddivisione in substringhe
Dim iLivelli As Integer 'numero massimo di livelli generale
Dim iLivRiga As Integer 'numero massimo di livelli per riga
Dim l As Integer 'indice di scansione livelli (substringhe)
Dim c As Integer 'indice di scansione colonne di substringhe
Dim r As Long 'indice di scansione righe
Dim bNormalize As Boolean 'segnale di normalizzazione parte alfabetica
'* -----------------------------------------------------------
'* impostazioni iniziali -------------------------------------
Set CurrentWS = Worksheets("Foglio1")
Set TempWS = Worksheets("Foglio2")
Set Temp1WS = Worksheets("Foglio3")
iLivelli = -1
'* -----------------------------------------------------------
'*-------------------------------------------------------------
'* vedi nota iniziale
sMsg = "SI VUOLE LA NORMALIZZAZIONE ANCHE DELLA PARTE ALFABETICA ?" _
& String(2, vbLf) _
& "normalizzando l'ordine sarà quello con cui excel nomina le colonne" _
& vbLf _
& "(A-Z ; AA-AZ ; BA-BZ;....)" _
& String(2, vbLf) _
& "NON normalizzando l'ordinamento avverrà raggruppando tutte le chiavi" _
& vbLf _
& "che hano la stessa lettera iniziale (prima tutte le A, poi tutte le B)" _
& vbLf _
& "indipendentemente dal numero di caratteri che compongono la parte alfanumerica della chiave"
If MsgBox(sMsg, _
vbQuestion + vbYesNo _
) _
= vbYes _
Then
bNormalize = True
End If
'*-------------------------------------------------------------
On Error GoTo Errori_Routine
'************************************************************
'* PRIMO PASSO *
'*----------------------------------------------------------*
'* analisi della tabella *
'************************************************************
With CurrentWS
'*debug----------
' sCont = ""
'*---------------
'* ciclo di scansione fino alla prima cella vuota
For r = 1 To .Rows.Count
'* preleva contenuto
sArgFrom = .Cells(r, 2)
If Len(Trim(sArgFrom)) = 0 Then
'* termina ciclo
Exit For
End If
'*---------------------
'* debug
If r = 92 Then
Stop
End If
'*---------------------
'* suddivide in substringhe
avTmp = Split(sArgFrom, "-")
If UBound(avTmp) + 1 > iLivelli Then
'* memo il numero massimo di livelli
iLivelli = UBound(avTmp) + 1
End If
'* ciclo di scrittura matrice di substringhe
'* memorizza a partire dal secondo elemento
'* nel primo il numero di livelli
For l = 0 To UBound(avTmp)
TempWS.Cells(r, l + 2) = avTmp(l)
Next
TempWS.Cells(r, 1) = l
'*debug -----------------------
' sCont = sCont _
' & .Cells(r, 2).Text _
' & vbLf
'*-----------------------------
Next
'*debug-----------------------------
' MsgBox sCont _
' & String(3, vbLf) _
' & "totale righe = " & r - 1 _
' & String(3, vbLf) _
' & "max Livelli = " & iLivelli
'*----------------------------------
End With
'************************************************************
'************************************************************
'* SECONDO PASSO *
'*----------------------------------------------------------*
'* analisi della matrice di substringhe *
'************************************************************
With TempWS
'* dimensiona la matrice(interna)
'* per la lunghezza max di ogni colonna
ReDim avMaxLen(iLivelli - 1)
'* ciclo di scansione per stabilire la lunghezza max
'* di ogni colonna di substringhe
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = Int(.Cells(r, 1))
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
If Len(sArgFrom) > avMaxLen(c - 2) Then
'*memo la lunghezza maggiore
avMaxLen(c - 2) = Len(sArgFrom)
End If
Next
Next
End With
'************************************************************
'************************************************************
'* TERZO PASSO *
'*----------------------------------------------------------*
'* normalizzazione delle substringhe *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
'*----------------------------------------------
'* vedi nota iniziale
If Not bNormalize And _
c = 2 _
Then
'* NON normalizza la parte alfabetica
'* (che per definizione è il primo livello)
Temp1WS.Cells(r, c - 1) = sArgFrom
Else
If Len(sArgFrom) < avMaxLen(c - 2) Then
'* normalizza con spazi a sinistra
'* (nella seconda matrice di transito)
Temp1WS.Cells(r, c - 1) = Space(avMaxLen(c - 2) - Len(sArgFrom)) _
& sArgFrom
Else
Temp1WS.Cells(r, c - 1) = sArgFrom
End If
End If
'*----------------------------------------------
Next
Next
End With
'************************************************************
'************************************************************
'* QUARTO PASSO *
'*----------------------------------------------------------*
'* composizione della chiave di ordinamento *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
sKeyOrd = ""
'* ciclo di scansione substringhe di riga
For c = 2 To iLivelli + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
'* imposta la proprietà testo per la cella
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
If Len(sArgFrom) = 0 Then
'* normalizza con tutti spazi livelli vuoti
Temp1WS.Cells(r, c - 1) = Space(avMaxLen(c - 2))
End If
sKeyOrd = sKeyOrd _
& Temp1WS.Cells(r, c - 1) _
& IIf((c - 1) = 1 Or (c - 1) = iLivelli, "", "-")
Next
'* debug ------------------------
' Debug.Print "<"; sKeyOrd; ">"
'* ------------------------------
'* memo chiave temporanea di ordinamento
CurrentWS.Cells(r, 1).NumberFormat = "@"
CurrentWS.Cells(r, 1) = sKeyOrd
Next
End With
'************************************************************
'************************************************************
'* QUINTO PASSO *
'*----------------------------------------------------------*
'* ordinamento *
'************************************************************
CurrentWS.Rows("1:" & r - 1).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'************************************************************
End
Errori_Routine:
MsgBox Err.Number & vbLf & Err.Description
Exit Sub
Resume 0
End Sub |
torni al Foglio1 (click su excel nella barra delle applicazioni)
copi la tabella da word
la incolli in B1 del Foglio1
vai al menu strumenti
scegli macro -->macro
(Passi_Ordinamento dovrebbe essere evidenziata)
premi il pulsante esegui.
NB.
ho ripostato il codice perchè ho fatto una variante che è spiegata nel messaggio che appare all'inizio dell'esecuzione
se ci fosse qualche problema puoi sempre contattarmi per messaggio privato
o per email (in chiaro nel mio profilo) facendoti riconoscere altrimenti il mio filtro scarta tutto quello che non è autorizzato |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 14:41 Oggetto: |
|
|
Il risutato che ho ottenuto dai tuoi dati, eseguendo la mia macro NON normalizzando la parte alfabetica (che per definizione è considerata solo nel primo livello) è questo:
| Citazione: |
A-1
A-2
A-30
A-110
A-110-7
A-111
A-111-2
A-210
A-220
A-222
A-300-1-2
A-301
A-301-5002
A-301-5012
A-302
A-302-1
A-302-2
A-302-3
A-302-1000
A-302-1001
A-302-1004-1
A-302-1004
A-302-1004-2
A-302-2100-1
A-302-3001
A-302-3001-2
A-302-9999
A-303
A-304
A-305-11-2
A-306-6000
A-307
A-308
A-308-8000
A-310
A-311
A-315
A-316
A-319
A-400-2
A-400-4-1
A-501
A-601-2-1
A-602-1
A-604-1005
A-803
B
B-0-2
B-1
B-1-4
B-2
B-201
B-210
B-300
C-1-2
C-1-3
C-1-4
C-1-5
C-3
C-4
C-5
C-5-1
C-5-1-2
C-6
C-101
C-201
C-203
D-1
D-1-0
D-1-0
D-1-1
D-1-3
D-1-4
D-2-0
D-2-0-3
D-2-0-4
D-2
D-2-4
D-2-6
D-2-10
D-3
D-30
D-40
D-50
D-100
D-100-000
D-100-001
D-100-002
D-100-003
D-100-004
D-100-011
D-100-013
D-100-014
D-100-003 Q.F.
D-101
D-101-0100-2
D-101-1000
D-101-9100-1
D-104
D-110-2
D-110-2-0
D-110-2-1
D-111-1
D-111-1-11-2
D-111-1-11-4
D-111
D-112
D-113-1
D-113
D-114-1
D-114-2
D-114
D-116
D-117-4-0100
D-117-7
D-119-2
D-119-3
D-120
D-121
D-125
D-130
D-140-10
D-140-12
D-140
D-140-50
D-150-10-6
D-150-10
D-150-13
D-150-13-2
D-150-13-3
D-150-13-4
D-150
D-150-13-7
D-150-13-9
D-150-13-10
D-150-13-12
D-150-13-17
D-150-15
D-150-15
D-150-20
D-150-30-1
D-150-30-2
D-150-30-7
D-150-30-8
D-150-100
D-150-200
D-150-300-1
D-150-300-1-1
D-200-0
D-200-0200-0
D-200-0200-0
D-200-FARN-3
D-200-FARN-4
D-200-FARN-4
D-200-FARN-7
D-200-FARN
D-200-MADA
D-201
D-201-7
D-201-F8
D-201-FARN-CO
D-201-FARN-E3
D-201-FARN-F0
D-201-FARN-F4
D-202
D-210
D-211-0
D-212
D-213
D-303
D-304
D-304-RD
D-305-1-2
D-305
D-305-2
D-305-5
D-305-5-1
D-310-1
D-400
D-400-1
D-400-1-0
D-400-2
D-400-4
D-401
D-403-1
D-403-1-0
D-403-1-2
D-403-2-1
D-403-2-6
D-404
D-404-1
D-404-3
D-405-A4
D-500
D-500-1-0
D-500-1000
D-500-2000
D-501
D-501-1004
D-600
D-600-4
D-700
D-700-2
D-701
D-701-2001-3
D-702-2
D-702-4
E-3
E-6
E-10-5
E-10-5-4
E-10-11
E-15-3
E-15
E-16
E-21
E-21-3
E-100
E-103-0
E-103-100
E-230
E-232
E-235
E-244
E-246-1-4
E-300
E-300-4-2
E-300-4-3
E-501
F-0-1
F-0-7-1000
F-1-PG
F-1-UAMA
F-2
F-3
F-4
F-200-1
F-203-23
F-204
F-301
F-309
F-400
F-401
F-402
F-411-7
F-413-1-7
F-450-3
F-450-6
F-450-6-PARM
F.0.7-1000
G-0-2-0
G-0-3-3
G-0-3-5
G-0
G-001
G-004-2
G-005
G-005-4
G-5-6
G-006
G-007
G-008-3
G-9-1
G-9-2
G-011-6
G-020
G-025-5-3
G-028
G-035
G-036
G-9.2
G-900
G-901
H-1
H-50
H-106
H-107
H-108
H-200
H-300
H-300-9-1
H-5+5
J-100
J-100-3
J-100-4
J-101-2
J-101
J-102
J-103
J-104
J-106
J-110
J-111
J-120
J-120-0
J-120-KJ03-1
J-130
J-133
J-133-UC
J-150-2-1
J-150-20
J-150
J-201
J-300
K-5-1
K-7
K-7-KE21
K-9
K-A
K-B-300-9
K-E
K-E-100
K-E-114
K-E-322
K-E-370-2
K-E-650
K-K-10
K-B1
K-D1-101
K-D1
K-F2-1
K-G1-106
K-L5
K-E21
K-E33
L-1
L-2
L-3
L-3-M
L-3-C0
L-3-F0
L-3-K0
L-4-7
L-4
L-5-1
L-5-2
L-5-2-0
L-5-2-1
L-5-2-4
L-5-3-1
L-5-3-2
L-5-3-4
L-5-4
L-5-6
L-5
L-6
L-6-1000
L-6-1017
L-6-1019
L-6-1030
L-6-4000-2
L-7-3
L-7-3-1
L-7-7
L-7-10
L-7
L-8
L-8-D0
L-8-B11
L-8-B16
M-2-1
M-10
M-110
M-112
M-200
M-400-1
N-5-0
N-100
N-100-6-RAI
N-200
N-401-2
N-505
|
come potrai notare ci sono anomalie (esempio D-100-003 Q.F. oppure F.0.7-1000) che dipendono dalla struttura della chiave; il codice considera 003 Q.F. oppure F.0.7 come unico livello e quindi dimensiona tutti gli altri (con spazi a sinistra) che sono giocoforza minori come valore di testo. |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 14:52 Oggetto: |
|
|
mi correggo:
per F.0.7 anche se tutte le altre substringhe del primo livello, NON sono
normalizzate con spazi a sinistra, è comunque una stringa più lunga delle altre. |
|
| Top |
|
|
torchiemana
Mortale devoto
Registrato: 28/09/05 14:31
Messaggi: 8
Residenza: roma
|
| Inviato: 24 Ott 2005 17:09 Oggetto: |
|
|
Lupo Grigio, cerco di arrancare dietro la tua graditissima celerità! Adesso non posso fare altro che ringraziarti; poi ti farò sapere.
GRAZIE |
|
| Top |
|
|
GrayWolf
Dio maturo
Registrato: 03/07/05 17:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 27 Ott 2005 11:32 Oggetto: |
 |
|
Revisione della macro per Word inserita precedentemente
| Codice: | Sub Passi_Ordinamento()
'***********************************************************
'* nota1 del 24.10.2005-1.01 (dopo il rilascio sul forum) *
'*---------------------------------------------------------*
'* nel caso in cui il riferimento alfabetico *
'* sia composto da più di una lettera, occorre *
'* richiedere l'autorizzazione a normalizzare *
'* anche tale riferimento. *
'* l'attuale struttura ordina nello stesso modo *
'* in cui excel denomina le colonne: A-Z; AA-AZ;BA-BZ.... *
'*---------------------------------------------------------*
'* SENZA la normalizzazione della parte alfabetica *
'* (vedi richiesta ed eccezione nella normalizzazione) *
'* l'ordinamento avviene elencando prima tutte le chiavi *
'* con radice A poi quelle con radice B e così via.... *
'***********************************************************
'***********************************************************
'* nota2 del 27.10.2005 *
'*---------------------------------------------------------*
'* dopo alcune prove effettuate sugli originali forniti: *
'* *
'* .1 modificata la normalizzazione con zeri anzichè spazi *
'* .2 introdotta la pulizia delle zone di lavoro *
'* .3 estensione della NON normalizzazione, se scelta, a *
'* TUTTE le parti alfabetiche o alfanumeriche nei li- *
'* velli di chiave *
'***********************************************************
'* definizioni -----------------------------------------------
Dim CurrentWS As Worksheet 'foglio contenente la tabella
Dim TempWS As Worksheet 'foglio per matrice di transito
Dim Temp1WS As Worksheet 'foglio per matrice di transito
Dim oRange As Range 'generico: di transito
Dim sArgFrom As String 'argomento chiave da eaminare
Dim sKeyOrd As String 'chiave di ordinamento
Dim sCont As String 'debug
Dim sMsg As String 'generico: testo del messaggio
Dim avMaxLen As Variant 'matrice di lunghezze massime per ogni livello
Dim avTmp As Variant 'matrice temporanea per suddivisione in substringhe
Dim iLivelli As Integer 'numero massimo di livelli generale
Dim iLivRiga As Integer 'numero massimo di livelli per riga
Dim l As Integer 'indice di scansione livelli (substringhe)
Dim c As Integer 'indice di scansione colonne di substringhe
Dim r As Long 'indice di scansione righe
Dim bNormalize As Boolean 'segnale di normalizzazione parte alfabetica
'*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27.10.2005 >>>>>>>>
Const Zeroes As String = "00000000000000000000000000000000000000000000000000"
'*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'* -----------------------------------------------------------
'* impostazioni iniziali -------------------------------------
Set CurrentWS = Worksheets("Foglio1")
Set TempWS = Worksheets("Foglio2")
Set Temp1WS = Worksheets("Foglio3")
iLivelli = -1
'*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27.10.2005 >>>>>>>>
'* pulizia dei fogli temporanei
With TempWS
.Activate
Cells.Select
Selection.ClearContents
End With
With Temp1WS
.Activate
Cells.Select
Selection.ClearContents
End With
'* pulizia della colonna per la chiave di ordinamento
With CurrentWS
.Activate
Set oRange = .Columns("A:A")
oRange.ClearContents
End With
'*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'* -----------------------------------------------------------
'*-------------------------------------------------------------
'* vedi nota1 iniziale
sMsg = "SI VUOLE LA NORMALIZZAZIONE ANCHE DELLE PARTI ALFABETICHE o ALFANUMERICHE?" _
& String(2, vbLf) _
& "normalizzando l'ordine sarà quello con cui excel nomina le colonne" _
& vbLf _
& "(A-Z ; AA-AZ ; BA-BZ;....)" _
& String(2, vbLf) _
& "NON normalizzando l'ordinamento avverrà raggruppando tutte le chiavi" _
& vbLf _
& "che hano la stessa lettera iniziale (prima tutte le A, poi tutte le B)" _
& vbLf _
& "indipendentemente dal numero di caratteri che compongono la parte alfanumerica della chiave"
If MsgBox(sMsg, _
vbQuestion + vbYesNo _
) _
= vbYes _
Then
bNormalize = True
End If
'*-------------------------------------------------------------
On Error GoTo Errori_Routine
'************************************************************
'* PRIMO PASSO *
'*----------------------------------------------------------*
'* analisi della tabella *
'************************************************************
With CurrentWS
'*debug----------
' sCont = ""
'*---------------
'* ciclo di scansione fino alla prima cella vuota
For r = 1 To .Rows.Count
'* preleva contenuto
sArgFrom = .Cells(r, 2)
If Len(Trim(sArgFrom)) = 0 Then
'* termina ciclo
Exit For
End If
'*---------------------
'* debug
' If r = 92 Then
' Stop
' End If
'*---------------------
'* suddivide in substringhe
avTmp = Split(sArgFrom, "-")
If UBound(avTmp) + 1 > iLivelli Then
'* memo il numero massimo di livelli
iLivelli = UBound(avTmp) + 1
End If
'* ciclo di scrittura matrice di substringhe
'* memorizza a partire dal secondo elemento
'* nel primo il numero di livelli
For l = 0 To UBound(avTmp)
TempWS.Cells(r, l + 2) = avTmp(l)
Next
TempWS.Cells(r, 1) = l
'*debug -----------------------
' sCont = sCont _
' & .Cells(r, 2).Text _
' & vbLf
'*-----------------------------
Next
'*debug-----------------------------
' MsgBox sCont _
' & String(3, vbLf) _
' & "totale righe = " & r - 1 _
' & String(3, vbLf) _
' & "max Livelli = " & iLivelli
'*----------------------------------
End With
'************************************************************
'************************************************************
'* SECONDO PASSO *
'*----------------------------------------------------------*
'* analisi della matrice di substringhe *
'************************************************************
With TempWS
'* dimensiona la matrice(interna)
'* per la lunghezza max di ogni colonna
ReDim avMaxLen(iLivelli - 1)
'* ciclo di scansione per stabilire la lunghezza max
'* di ogni colonna di substringhe
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = Int(.Cells(r, 1))
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
If Len(sArgFrom) > avMaxLen(c - 2) Then
'*memo la lunghezza maggiore
avMaxLen(c - 2) = Len(sArgFrom)
End If
Next
Next
End With
'************************************************************
'************************************************************
'* TERZO PASSO *
'*----------------------------------------------------------*
'* normalizzazione delle substringhe *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
'* ciclo di scansione substringhe di riga
For c = 2 To iLivRiga + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
'*----------------------------------------------
'* vedi nota1 iniziale
If Not bNormalize Then
If Not IsNumeric(sArgFrom) Then
'* NON normalizza la parte alfabetica
'* (vedi nota2 iniziale)
Temp1WS.Cells(r, c - 1) = sArgFrom
Else
If Len(sArgFrom) < avMaxLen(c - 2) Then
'* normalizza con zeri a sinistra
'* (nella seconda matrice di transito)
'*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27.10.2005 >>>>>>>>
Temp1WS.Cells(r, c - 1) = Left(Zeroes, avMaxLen(c - 2) - Len(sArgFrom)) _
& sArgFrom
'*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Else
Temp1WS.Cells(r, c - 1) = sArgFrom
End If
End If
End If
If bNormalize Then
If Len(sArgFrom) < avMaxLen(c - 2) Then
'* normalizza con zeri a sinistra
'* (nella seconda matrice di transito)
'*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27.10.2005 >>>>>>>>
Temp1WS.Cells(r, c - 1) = Left(Zeroes, avMaxLen(c - 2) - Len(sArgFrom)) _
& sArgFrom
'*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Else
Temp1WS.Cells(r, c - 1) = sArgFrom
End If
End If
'*----------------------------------------------
Next
Next
End With
'************************************************************
'************************************************************
'* QUARTO PASSO *
'*----------------------------------------------------------*
'* composizione della chiave di ordinamento *
'************************************************************
With TempWS
'* ciclo di scansione per la normalizzazione
For r = 1 To .Cells.Count
'* rileva contenuto cella del numero di livelli
iLivRiga = .Cells(r, 1)
If iLivRiga = 0 Then
'* esce dal ciclo
Exit For
End If
sKeyOrd = ""
'* ciclo di scansione substringhe di riga
For c = 2 To iLivelli + 1
'* rileva la substringa
sArgFrom = .Cells(r, c)
'* imposta la proprietà testo per la cella
Temp1WS.Cells(r, c - 1).NumberFormat = "@"
If Len(sArgFrom) = 0 Then
'* normalizza con tutti zeri i livelli vuoti
'*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27.10.2005 >>>>>>>>
Temp1WS.Cells(r, c - 1) = Left(Zeroes, avMaxLen(c - 2))
'*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End If
sKeyOrd = sKeyOrd _
& Temp1WS.Cells(r, c - 1) _
& IIf((c - 1) = iLivelli, "", "-")
Next
'* debug ------------------------
' Debug.Print "<"; sKeyOrd; ">"
'* ------------------------------
'* memo chiave temporanea di ordinamento
CurrentWS.Cells(r, 1).NumberFormat = "@"
CurrentWS.Cells(r, 1) = sKeyOrd
Next
End With
'************************************************************
'************************************************************
'* QUINTO PASSO *
'*----------------------------------------------------------*
'* ordinamento *
'************************************************************
CurrentWS.Rows("1:" & r - 1).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
CurrentWS.Columns("A:A").Select
'************************************************************
End
Errori_Routine:
MsgBox Err.Number & vbLf & Err.Description
Exit Sub
Resume 0
End Sub |
Grazie in anticipo ( a chi volesse farne)
per suggerimenti e/o segnalazione di anomalie |
|
| Top |
|
|
|
|
Non puoi inserire nuovi argomenti
Non puoi rispondere a nessun argomento
Non puoi modificare i tuoi messaggi
Non puoi cancellare i tuoi messaggi
Non puoi votare nei sondaggi
|
|
FAQ
Cerca
Lista utenti
Gruppi
Registrati
Profilo
Messaggi privati
Log in
