Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Excel VBA- Errore Metodo Range dell'oggetto global non riuscito.

984 views
Skip to first unread message

Eleonora

unread,
Dec 21, 2009, 10:04:58 AM12/21/09
to
Salve a tutti, sono nuova nel forum.. spero tanto che mi possiate
aiutare!
ho scritto un algoritmo che risolve il seguente problema:

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

plinius

unread,
Dec 21, 2009, 10:48:29 AM12/21/09
to

"Eleonora" <eleonora...@hotmail.com> ha scritto nel messaggio
news:48acc41c-6f06-43ad...@o28g2000yqh.googlegroups.com...

Salve a tutti, sono nuova nel forum.. spero tanto che mi possiate
aiutare!
ho scritto un algoritmo che risolve il seguente problema:

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.


r

unread,
Dec 21, 2009, 12:28:15 PM12/21/09
to

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

0 new messages