Forum di Excel e VBA, per condividere esperienze e risolvere problemi su:
Excel, Word, Access, Power Point, Microsoft Office, macro, Visual Basic e Visual Studio.

molti If consecutivi



  • molti If consecutivi
    di gagen (utente non iscritto) data: 16/05/2013 22:01:02

    ragazzi datemi una mano perchè proprio non ci arrivo

    con l'aiuto anche di vecchio frac ho messo su un bel file che lavora molto bene. ora vorrei incrementarlo con una userform in cui inserire dei valori in alcune textbox e combobox per fare una ricerca in un foglio e copiare le righe trovate in un altro foglio
    c'è una combobox obbligatoria, mentre gli altri valori possono essere inseriti oppure no e in mix tra loro.
    il codice sotto funziona per ogni singolo caso (che per convenienza ho diviso dai puntini. ovviamente la su non funge), ma a me serve che la sub analizzi tutte le possibilità, fermandosi quando una di esse è trovata oppure no restituendo un messaggio
    per esempio
    inserisco 4 parametri (primo codice): li trova: esegue il comando for: si chiude la sub con il messaggio "Ricerca ok" di fine sub
    inserisco 4 parametri (primo codice): non li trova oppure ne trova solo 2 o solo 3: si chiude la sub con il messaggio "Nessun record trovato inserire parametri diversi o in meno"
    inserisco 2 parametri (quarto, sesto, settimo codice): la sub dovrebbe scorrere tutte le possibili combinazioni di codice scritto e se trova la condizione o non la trova restituire gli stessi messaggi di sopra

    grazie come sempre

     
    Private Sub CommandButton1_Click()
Dim N1 As String, n2 As String, n3 As String
Dim N4 As String, n5 As Integer
Dim Ro As Integer
Set sha = Worksheets("archivio")
Application.ScreenUpdating = False
On Error Resume Next
N1 = TextBox1.Text
n2 = TextBox2.Text
n3 = ComboBox1.Value
N4 = ComboBox2.Value
n5 = ComboBox4.Value
Ro = 2
Set shr = Worksheets("ricerca")
shr.Activate
shr.Range("A2:V3000").ClearContents

If n3 = "" Then
MsgBox ("ATTENZIONE CAMPO UFFICIO OBBLIGATORIO"), vbCritical
Exit Sub
End If

If N1 <> "" And n2 <> "" Then
MsgBox ("ATTENZIONE   SCEGLIRE SOLO UN NOME")
Exit Sub
End If

.........................................................................................

If N1 <> "" Or n2 <> "" And N4 <> "" And n5 <> "" Then 'primo codice = uff + nc1 o nc2 + ind + zona
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
.....................................................................................................


If N1 <> "" Or n2 <> "" And N4 <> "" And n5 = "" Then  'secondo codice = uff + nc1 o nc2 + ind
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
     For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
....................................................................................

If N1 <> "" Or n2 <> "" And N4 = "" And n5 <> "" Then   'terzo codice: uff + nc1 o nc2 + zona
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
     For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
................................................................................

If N1 <> "" Or n2 <> "" And N4 = "" And n5 = "" Then   'quarto codice = uff + nc1 o nc2
        For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
     For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If

............................................................................

If N1 = "" And n2 = "" And N4 <> "" And n5 <> "" Then   'quinto codice: uff  + ind + zona
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If

..........................................................................


If N1 = "" And n2 = "" And N4 <> "" And n5 = "" Then   'sesto codice: uff  + ind
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
...............................................................................


If N1 = "" And n2 = "" And N4 = "" And n5 <> "" Then    'settimo codice: uff + zona
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
.............................................................................

If N1 = "" And n2 = "" And N4 = "" And n5 = "" Then       ' ottavo codice: solo uff
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 Then
        Range(c.Offset(0, -6), c.Offset(0, 16)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
End If
.............................................................................




If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else
    Dim risp As Integer
    risp = MsgBox("Nessun record trovato" & vbLf & "inserire parametri diversi o in meno")
    shr.Activate
    shr.Range("A2:V3000").ClearContents
End If






End Sub



  • di mabolsie (utente non iscritto) data: 16/05/2013 22:41:05

    Ciao gagen, se ho capito bene vorresti semplificare eliminando gli IF, una soluzione ci sarebbe, utilizzare il Select Case.

    Ciao Max



  • di Vecchio Frac data: 18/05/2013 14:14:19

    Per gestire i parametri, se non ricordo male, esiste anche IsMissing.
    Altrimenti basta studiare bene il meccanismo di Select Case, come ha già ben detto mabolsie, se tutti i campi interessati sono sempre solo N1, N2, N4 e N5.






  • di gagen (utente non iscritto) data: 19/05/2013 11:33:41

    scusate se vi rispondo solo ora ma ho problemi di rete.
    intanto nella mia ignoranza con il codice (vi prego non ridete!!!!) sotto funziona a metà, perchè se i parametri inseriti siano essi 1 oppure 2 oppure 3 oppure 4 sono corretti, la sub è ok.
    Se invece uno di essi e sbagliato, quindi non presente nella riga cercata, invece di uscirmi SUBITO il messaggio
    ("Nessun record trovato" & vbLf & "inserire parametri diversi o in meno") di fine sub, mi esce lo stesso la ricerca ok con i rimanenti parametri trovati, per varie volte fino a quando non arriva alla fine della sub ed esce il messaggio giusto.
    Bisognerebbe solo far uscire subito il messaggio giusto se non tutti i parametri sono corretti.
    I campi interessati sono sempre i soliti. Si può fare facile con il Select Case? Devo capire prima cosa è poi come funziona. Mi ci metterò......... se mi date qualche dritta vi ringrazio

     
    Private Sub CommandButton1_Click()
Dim N1 As String, n2 As String, n3 As String
Dim N4 As String, n5 As String, n6 As String
Dim Ro As Integer
Set shr = Worksheets("ricerca")
Set sha = Worksheets("archivio")
Application.ScreenUpdating = False
On Error Resume Next
N1 = TextBox1.Text
n2 = TextBox2.Text
n3 = ComboBox1.Value
N4 = ComboBox2.Value
n5 = ComboBox4.Value
Ro = 2
shr.Activate
shr.Range("A2:V3000").ClearContents

If n3 = "" Then
MsgBox ("ATTENZIONE CAMPO UFFICIO OBBLIGATORIO"), vbCritical
Exit Sub
End If
'''''''''

If N1 <> "" And n2 <> "" Then
MsgBox ("ATTENZIONE   SCEGLIRE SOLO UN NOME")
Exit Sub
End If

If N1 <> "" Or n2 <> "" And N4 <> "" And n5 <> "" Then 'uff + nc1 o nc2 + ind + zona

    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
 
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 100

End If

10:
If N1 <> "" Or n2 <> "" And N4 <> "" And n5 = "" Then  'uff + nc1 o nc2 + ind

    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
 
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 110
End If


20:
If N1 <> "" Or n2 <> "" And N4 = "" And n5 <> "" Then   'uff + nc1 o nc2 + zona


    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
 
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 120
End If

30:
If N1 <> "" Or n2 <> "" And N4 = "" And n5 = "" Then   'uff + nc1 o nc2


        For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -2) = N1 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
 
    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, -1) = n2 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 130
End If

40:
If N1 = "" And n2 = "" And N4 <> "" And n5 <> "" Then   'uff  + ind + zona


    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 1) = N4 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 140
End If

50:
If N1 = "" And n2 = "" And N4 <> "" And n5 = "" Then   'uff  + ind

    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 1) = N4 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 150
End If

60:
If N1 = "" And n2 = "" And N4 = "" And n5 <> "" Then    'uff + zona


    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 And c.Offset(, 4) = n5 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 160
End If

70:
If N1 = "" And n2 = "" And N4 = "" And n5 = "" Then

    For Each c In sha.Range("g:g")
        If c.Value = "" Then Exit For
        If c.Value = n3 Then
        Range(c.Offset(0, -6), c.Offset(0, 15)).Copy
        shr.Cells(Ro, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Ro = Ro + 1
        End If
    Next c
GoTo 170
End If


100:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 10

End If

110:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 20

End If

120:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 30

End If

130:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 40

End If

140:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 50

End If

150:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 60

End If

160:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else

GoTo 70

End If

170:
If shr.Range("a2") <> "" Then
    MsgBox "Ricerca ok" & vbLf & "scegli il numero del reclamo o apri pagina ricerca"
    ComboBox3.RowSource = "ricerca!a2:a1500"
    Exit Sub
Else
  Dim risp As Integer
    risp = MsgBox("Nessun record trovato" & vbLf & "inserire parametri diversi o in meno")

End If

End Sub


  • post precedente errato
    di gagen data: 19/05/2013 12:01:11

    VI CHIEDO VERAMENTE SCUSA ma non so come correggere il post precedente e quindi ne invio un altro
    il codice prima non è quello che avevo fatto (chissà dove è finito..... tra le mille prove!!) e quindi non fa quello che dicevo.
    tornerò a lavorarci con un po' di calma
    scusate ancora



  • di mabolsie (utente non iscritto) data: 20/05/2013 18:31:14

    non puoi allegare il file al fine di farci capire cosa vuoi fare, magari qualcuno ha una soluzione più semplice.
    Ciao
 


by Globosoft © 2018 Regole di utilizzo | Contatti | Privacy Policy