Excel Excel VBA(Formulário) - Código para verificar disponibilidade de setor

[tt_branco]

Boa noite! Estou desenvolvendo um formulário de cadastro e estou tendo problemas com meu código pois ficou muito longo e demora um pouquinho para iniciar, agradeço se tiverem uma ideia melhor ou uma forma de deixar mais rápido.... segue:

(Foi proposital usar label como destino final de dados)

____________________________________

Private Sub BtnVerificar_Click()

 

Call Verificar1

Call Verificar2

Call Verificar3

.

.

.

Call Verificar10

 

End Sub

____________________________________

Sub Verificar1()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "1" Then
    
    UserForm1.Q1.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q1.Caption = "Disponivel"

    
End Sub

_______________________________________

Sub Verificar2()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "2" Then
    
    UserForm1.Q2.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q2.Caption = "Disponivel"

    
End Sub

______________________________________

Sub Verificar3()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "3" Then
    
    UserForm1.Q3.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q3.Caption = "Disponivel"

    
End Sub

[tt_branco]

Boa noite! Estou desenvolvendo um formulário de cadastro e estou tendo problemas com meu código pois ficou muito longo e demora um pouquinho para iniciar, agradeço se tiverem uma ideia melhor ou uma forma de deixar mais rápido.... segue:

(Foi proposital usar label como destino final de dados)

____________________________________

Private Sub BtnVerificar_Click()

 

Call Verificar1

Call Verificar2

Call Verificar3

.

.

.

Call Verificar10

 

End Sub

____________________________________

Sub Verificar1()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "1" Then
    
    UserForm1.Q1.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q1.Caption = "Disponivel"

    
End Sub

_______________________________________

Sub Verificar2()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "2" Then
    
    UserForm1.Q2.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q2.Caption = "Disponivel"

    
End Sub

______________________________________

Sub Verificar3()

Sheets("Planilha1").Activate

linha = Range("A2").End(xlDown).Row + 1
lin = 2
While lin < linha

    If Cells(lin, 3) = "3" Then
    
    UserForm1.Q3.Caption = "Indisponivel"
    
    Exit Sub
    End If

    lin = lin + 1
Wend

    UserForm1.Q3.Caption = "Disponivel"

    
End Sub

[Midori]

@tt_branco  Algumas melhores que podem ser feitas: Usar a função Find em vez de um loop para procurar os valores; Criar apenas uma Sub com parâmetros para passar o controle e o número da busca.

 

Como não tenho a planilha para testar, talvez seja preciso fazer alguma adaptação,

 

Private Sub BtnVerificar_Click()
    Dim L As Object
        
    For Each L In Me.Controls
        If TypeName(L) = "Label" Then
            If Left(L.Name, 1) = "Q" Then
                Call Verificar(Replace(L.Name, "Q", ""), L)
            End If
        End If
    Next L
End Sub

Sub Verificar(Numero As String, Label As Object)
    Dim R As Range
    
    Set R = Sheets("Planilha1").[C:C].Find(Numero, , xlValues, xlWhole)

    If R Is Nothing Then
        Label.Caption = "Disponivel"
    Else
        Label.Caption = "Indisponivel"
    End If
End Sub

 

[Midori]

Esse tópico está duplicado,