|
| Precedente :: Successivo |
| Autore |
Messaggio |
torchiemana
Mortale devoto
Registrato: 28/09/05 13:31
Messaggi: 8
Residenza: roma
|
 Inviato: 24 Ott 2005 09: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 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 13: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 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 13: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 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 24 Ott 2005 13: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 13:31
Messaggi: 8
Residenza: roma
|
| Inviato: 24 Ott 2005 16: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 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...
|
| Inviato: 27 Ott 2005 10: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
