Controllo foglio

Hai un problema con Excel?

Nuova discussione

Controllo" foglio"
di davide (utente non iscritto) data: 04/04/2015 17:43:37
Buongiorno a tutti, all'interno di queste due righe di comando

For Each Cella In my_range_1

Set my_range_2 = wbk_1.Sheets(Trim(Cella)).Range("d16:d2000").SpecialCells(xlCellTypeConstants)

ma l'esecuzione si blocca perché il foglio non esiste

vorrei inserire un controllo per vedere se il foglio (Trim(Cella)) esiste e se non esiste allora che passi alla Cella successiva

grazie

Sub Estrazione_generale()

Dim wbk_1 As Workbook

Dim fso As Object

Dim my_range_1 As Range
Dim my_range_2 As Range
Dim my_range_3 As Range



Dim Cella As Range
Dim Cella_1 As Range


'Dim Riga As Long


Set wbk_1 = ThisWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set my_range_1 = wbk_1.Sheets("Generale").Range("B4:B20000").SpecialCells(xlCellTypeConstants)
Set my_range_3 = wbk_1.Sheets("Generale").Range("d2:BBB2").SpecialCells(xlCellTypeConstants)


For Each Cella In my_range_1

    Set my_range_2 = wbk_1.Sheets(Trim(Cella)).Range("d16:d2000").SpecialCells(xlCellTypeConstants)

di Vecchio Frac data: 04/04/2015 18:32:32
La soluzione più spiccia è "On Error Resume Next" ma è un comando pericoloso, meglio gestire con una trappola per errori più esplicita oppure con una Function apposta.

Function sheet_exists(s As String) As Boolean
Dim ws As Worksheet
    sheet_exists = False
    For Each ws In ThisWorkbook.Worksheets
        If LCase(ws.Name) = LCase(s) Then sheet_exists = True: Exit Function
    Next
End Function

di scossa data: 04/04/2015 19:07:13
Ciao,

io propenderei per un approccio diverso: creerei una stringa con tutti i nomi dei fogli:

  For Each ws In wbk_1.Worksheets
    sWs = sWs & "#" & ws.Name
  Next
  sWs = sWs & "#"

dopo di che verificherei la presenza con la solita InStr():

  For Each Cella In my_range_1
    sWsName = Trim(Cella.Value)
    If InStr(1, sWs, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d2000").SpecialCells(xlCellTypeConstants)
    End If
    '.....

Comunque bisogna ricordare che se il metodo SpecialCells non trova alcuna cella restituisce errore, che quindi andrebbe gestito.

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

di davide (utente non iscritto) data: 05/04/2015 15:31:46
Ho provato ad inserire il listato di "scossa" ma sbaglio qualcosa...

Sub Estrazione_generale()


Dim wbk_1 As Workbook

Dim fso As Object

Dim my_range_1 As Range
Dim my_range_2 As Range
Dim my_range_3 As Range


Dim range_a As Range
Dim range_a_row As Integer
Dim range_a_column As Integer


Dim range_b_row As Integer
Dim range_b_column As Integer

Dim Cella As Range
Dim Cella_1 As Range
Dim Cella_2 As Double

Dim sWsName  As String
Dim sWs  As String
Dim ws As Worksheet

Set wbk_1 = ThisWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set my_range_1 = wbk_1.Sheets("Generale").Range("B4:B20000").SpecialCells(xlCellTypeConstants)
Set my_range_3 = wbk_1.Sheets("Generale").Range("d2:BBB2").SpecialCells(xlCellTypeConstants)


  For Each ws In wbk_1.Worksheets
    sWs = sWs & "#" & ws.Name
  Next
  sWs = sWs & "#"

For Each Cella In my_range_1

    sWsName = Trim(Cella.Value)
    If InStr(1, sWs, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d2000").SpecialCells(xlCellTypeConstants)
    End If

    'Set my_range_2 = wbk_1.Sheets(Trim(Cella)).Range("d16:d2000").SpecialCells(xlCellTypeConstants)

        With my_range_2
        For Each Cella_1 In my_range_3
        Set range_a = .Find(what:=Cella_1, LookIn:=xlValues)
    
            If Not range_a Is Nothing Then
                range_a_row = range_a.Row
                range_a_column = range_a.Column
                range_b_row = Cella_1.Row
                range_b_column = Cella_1.Column
                Cella_2 = wbk_1.Sheets(Trim(Cella)).Range("h" & range_a_row)
                wbk_1.Sheets("Generale").Cells(Cella.Row, range_b_column) = Cella_2
                
            
            
            
            End If
        Next
        End With
    

Next

End Sub

di davide (utente non iscritto) data: 05/04/2015 15:54:29
Cosi' funziona. Ma perché è pericoloso il comando:
On Error Resume Next

Sub Estrazione_generale()


Dim wbk_1 As Workbook

Dim fso As Object

Dim my_range_1 As Range
Dim my_range_2 As Range
Dim my_range_3 As Range


Dim range_a As Range
Dim range_a_row As Integer
Dim range_a_column As Integer


Dim range_b_row As Integer
Dim range_b_column As Integer

Dim Cella As Range
Dim Cella_1 As Range
Dim Cella_2 As Double

Dim wSheet As Worksheet

Set wbk_1 = ThisWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set my_range_1 = wbk_1.Sheets("Generale").Range("B4:B20000").SpecialCells(xlCellTypeConstants)
Set my_range_3 = wbk_1.Sheets("Generale").Range("d2:BBB2").SpecialCells(xlCellTypeConstants)


  

For Each Cella In my_range_1
On Error Resume Next
Set wSheet = Sheets(Trim(Cella))

If Not wSheet Is Nothing Then

        Set my_range_2 = wbk_1.Sheets(Trim(Cella)).Range("d16:d2000").SpecialCells(xlCellTypeConstants)

        With my_range_2
        For Each Cella_1 In my_range_3
        Set range_a = .Find(what:=Cella_1, LookIn:=xlValues)
    
            If Not range_a Is Nothing Then
                range_a_row = range_a.Row
                range_a_column = range_a.Column
                range_b_row = Cella_1.Row
                range_b_column = Cella_1.Column
                Cella_2 = wbk_1.Sheets(Trim(Cella)).Range("h" & range_a_row)
                wbk_1.Sheets("Generale").Cells(Cella.Row, range_b_column) = Cella_2
                
            
            
            
            End If
        Next
        End With
End If

Next

End Sub

di davide (utente non iscritto) data: 05/04/2015 16:01:07
Il listato gira ma estrae correttamente i dati solo fino a quando non trova una cella a cui non corrisponde alcun foglio. Da quel momento continua a girare ma i dati estratti sono sbagliati

di scossa data: 06/04/2015 10:58:29
cit. davide: "ma sbaglio qualcosa..."

Sì, tutto quello che riguarda devi metterlo all'interno del costrutto IF ... Then

scossa's web site

    If InStr(1, sWs, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d2000").SpecialCells(xlCellTypeConstants)
        With my_range_2
                '........
        End With
        '........
    End If

di Vecchio Frac data: 06/04/2015 11:58:47
cit. "Ma perché è pericoloso il comando:
On Error Resume Next"
---> E' virtualmente pericoloso non nel senso che ti scoppia il pc ma perchè l'interprete continua ad eseguire il codice quando trova qualsiasi errore, che quindi non ti viene segnalato. L'esecuzione continua e arriva fino alla fine, tutto sembra filare liscio: ma in realtà se si è verificato un errore questo non viene gestito... con risultati imprevedibili.
Ad esempio se la copia di un file per backup fallisce per qualsiasi motivo (disco pieno, nome di file non corretto, file esistente, ecc.) e l'interprete non ti avvisa? tu credi che la copia sia stata correttamente completata e poi sovrascrivi il file, perdendo il backup :)

di davide (utente non iscritto) data: 07/04/2015 14:50:23
Grazie funziona! Ma ho dovuto togliere
.SpecialCells(xlCellTypeConstants)
Come mai si blocca anche se nelle celle vi sono valori? Se lo tolgo poi funziona correttamente

  If InStr(1, sWs, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d2000")
        With my_range_2
                '........
        End With
        '........
    End If

di davide (utente non iscritto) data: 07/04/2015 18:19:30
Per mettere in forma matriciale una formula..

wbk_1.Sheets("AUX_1").Range("d4:xj387").formulArray = "=wbk_1.Sheets("Generale").Range("d4:xj387")"
ma non funziona
di Davide (utente non iscritto) data: 07/04/2015 19:32:10
Per precisare il post precedente.
Vorrei scrivere in VBA quello che faccio fare con queste formule:
1) {=MATR.PRODOTTO(XZ252:AHK252;$D$393:$XY$638)+D252:XY252}

e

2) {=D238:XY238}

ad es. ho provato a scrivere questo listato per il punto
wbk_1.Sheets("AUX_1").Range("d4:xj387").formulArray = wbk_1.Sheets("Generale").Range("d4:xj387")

ma non funziona

Vuoi Approfondire?