ho la seguente lista:
1.2
1.2.1
1.2.1.1
1.2.1.2
1.2.2
1.3
1.3.1
1.3.2
1.4
l'algoritmo mi deve restituire:
1.2.1.1
1.2.1.2
1.2.2
1.3.1
1.3.2
1.4
queste elencate sono attività, quindi deve estrarre l'ultimo livello
per ciascuna attività..
I dati nella lista sono letti da un foglio excel, quindi la colonna è
fissa e si scorrono le righe.
L'algoritmo è il seguente:
Private Sub UserForm_Initialize()
Dim listSize As Integer
Dim k As Integer, j As Integer
Dim currentActivity As String, found As Boolean, newActivity As String
Dim maximalActivity As String
'cont indica il numero dell'ultima riga occupata e parte dalla riga 3
'perchè è la prima occupata per come ho impostato il foglio excel
listSize = 3
Do While Range("B" & listSize).Value <> Empty
listSize = listSize + 1
Loop
k = 3
currentActivity = ""
j = 4
found = False
newActivity = ""
Do While k < listSize
currentActivity = Range("B" & k).Value
found = False
Do While j < listSize
Select Case found
Case True
Exit Do
Case False
nextActivity = Range("B" & j).Value
If InStr(nextActivity, currentActivity) <> 0 Then
j = j + 1
currentActivity = nextActivity
Else
MsgBox currentActivity
j = j + 1
found = True
End If
End Select
k = k + 1
Loop
Loop
End Sub
L'algoritmo funziona in quanto estrare le attività in base al criterio
che ho detto precedentemente, però mi segnala il seguente errore:
Metodo "Range" dell'oggetto Global non riuscito . Errore run time 1004
prima che compare quest'errore excel si blocca e si chiude.
Secondo voi questo problema è risolvibile?
spero tanto che mi possiate aiutare..
Grazie
ho la seguente lista:
1.2
1.2.1
1.2.1.1
1.2.1.2
1.2.2
1.3
1.3.1
1.3.2
1.4
l'algoritmo mi deve restituire:
1.2.1.1
1.2.1.2
1.2.2
1.3.1
1.3.2
1.4
queste elencate sono attivit�, quindi deve estrarre l'ultimo livello
per ciascuna attivit�..
I dati nella lista sono letti da un foglio excel, quindi la colonna �
fissa e si scorrono le righe.
L'algoritmo � il seguente:
Private Sub UserForm_Initialize()
Dim listSize As Integer
Dim k As Integer, j As Integer
Dim currentActivity As String, found As Boolean, newActivity As String
Dim maximalActivity As String
'cont indica il numero dell'ultima riga occupata e parte dalla riga 3
'perch� � la prima occupata per come ho impostato il foglio excel
L'algoritmo funziona in quanto estrare le attivit� in base al criterio
che ho detto precedentemente, per� mi segnala il seguente errore:
Metodo "Range" dell'oggetto Global non riuscito . Errore run time 1004
prima che compare quest'errore excel si blocca e si chiude.
Secondo voi questo problema � risolvibile?
spero tanto che mi possiate aiutare..
Grazie
*************
Risp
*************
In B3:B11 c'� la lista:
1.2
1.2.1
1.2.1.1
1.2.1.2
1.2.2
1.3
1.3.1
1.3.2
1.4
Inserisci in C3
=SE(SINISTRA(B4;LUNGHEZZA(B3))=B3;"";B3)
e trascina in basso fino a C11
Ciao,
E.
non saprei ... comunque questa sotto restituisce un elenco in una
listbox e non va in errore ...
incolla il codice nel modulo di classe della userform
'Userform1 con listbox1
Private Sub UserForm_Initialize()
Dim i As Long
Dim rng As Excel.Range
i = UltimaRiga(, [b:b])
If i < 3 Then Exit Sub
Set rng = [b3].Resize(i - 2)
Debug.Print rng.Address
Me.ListBox1.List = Lista_Att(rng)
End Sub
Function Lista_Att(rng As Excel.Range)
Dim dic1 As Object
Dim tRng As Excel.Range
Dim re As Object
Dim v, s As String
Set dic1 = CreateObject("scripting.dictionary")
Set re = CreateObject("vbscript.regexp")
For Each tRng In rng
If dic1.Exists(CStr(tRng.Value)) = False Then
dic1.Add CStr(tRng.Value), ""
End If
Next
re.Pattern = "\.\d$"
For Each v In dic1
s = re.Replace(v, "")
If dic1.Exists(s) Then
dic1.Remove s
End If
Next
Lista_Att = dic1.Keys
End Function
Function UltimaRiga(Optional Sh As Worksheet, _
Optional rng As Range) As Long
'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng
If Sh Is Nothing Then
If rng Is Nothing Then
Set rng = [a1].Parent.UsedRange
End If
Else
Set rng = Sh.UsedRange
End If
On Error Resume Next
UltimaRiga = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
saluti
r