Explorar Excel: 10 - Perguntas e Respostas

10 - Perguntas e Respostas

Tire suas dúvidas sobre Excel básico e avançado.


Nesta página, André irá tirar dúvidas de nossos seguidores sobre o Excel em todos os níveis (do básico ao avançado). As respostas serão feitas por escrito ou em vídeo.




1 - Fórmula pode abrir uma MsgBox?

https://youtu.be/zqIVQHtIjiI
CÓDIGOS:
Private Sub Worksheet_Change(ByVal Target As Range)
       If Target.Address <> "$A$1" Then
   
          Exit Sub
       End If
  
       If Target.Address = "$A$1" And Target.Value = "Carlos" Then
 
            MsgBox "Você escreveu o nome CARLOS na célula A1."
       End If
End Sub



2 - Como apagar várias linhas obedecendo uma condição usando VBA?

https://youtu.be/cTFYZQo5KAM
CÓDIGOS:
Sub DeletarVendidosA1()
       For Lin = 4 To 21
           If Cells(Lin, 7).Value = "Pago" Then
                 ActiveSheet.Range(Cells(Lin, 2), Cells(Lin, 7)).Select
  
               Selection.Delete Shift:=xlUp
 
         End If
 
      Next Lin

       Range("B4:G4").Select
       Selection.Copy

       Range("B4:G21").Select
       Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
       Application.CutCopyMode = False

       Cells(4, 1).Select
End Sub
_______________________________________
Sub DeletarVendidosA2()
       For Lin = 4 To 21
            ActiveSheet.Range(Cells(Lin, 2), Cells(Lin, 7)).Select
  
          Application.Wait Now + TimeValue("00:00:01")

 
           If Cells(Lin, 7).Value = "Pago" Then
 
                Application.Wait Now + TimeValue("00:00:01")
 
                 ActiveSheet.Range(Cells(Lin, 2), Cells(Lin, 7)).Select
   
               Application.Wait Now + TimeValue("00:00:01")
  
                Selection.Delete Shift:=xlUp
     
             Application.Wait Now + TimeValue("00:00:01")
    
        End If
       Next Lin

 
      Cells(4, 1).Select
End Sub



2B - Errata ao vídeo "Como apagar várias linhas obedecendo uma condição usando VBA?"

https://youtu.be/pKgnw4pXda0
CÓDIGOS:
Sub DeletarVendidosA()
       Dim Lin As Integer
       Dim shtPatio As Worksheet Set shtPatio = Sheets("Pátio")

       For Lin = 4 To 21
A:
            If shtPatio.Cells(Lin, 7).Value = "Pago" Then
                  shtPatio.Range(Cells(Lin, 1), Cells(Lin, 7)).Select
 
                 Selection.Delete Shift:=xlUp
 
                GoTo A:
            End If
  
     Next Lin

 
      shtPatio.Cells(4, 1).Select
       Application.CutCopyMode = False 
End Sub



3 - No VBA, como copiar e colar linhas entre abas obedecendo uma condição?

https://youtu.be/Qa7pOOaE4E4
CÓDIGOS:
Sub TransferirVendidos()
        Set shtPatio = Sheets("Pátio")
        Set shtV = Sheets("Vendidos")

        For LinPat = 4 To 21
            If shtPatio.Cells(LinPat, 7).Value = "Vendido" Then 
   
            For LinVend = 4 To 100
    
               If shtV.Cells(LinVend, 2).Value = "" Then
                        shtV.Cells(LinVend, 2).Value = shtPatio.Cells(LinPat, 2).Value
                        shtV.Cells(LinVend, 3).Value = shtPatio.Cells(LinPat, 3).Value
                        shtV.Cells(LinVend, 4).Value = shtPatio.Cells(LinPat, 4).Value
                        shtV.Cells(LinVend, 5).Value = shtPatio.Cells(LinPat, 5).Value
                        shtV.Cells(LinVend, 6).Value = shtPatio.Cells(LinPat, 6).Value
                        shtV.Cells(LinVend, 7).Value = shtPatio.Cells(LinPat, 7).Value
                        GoTo Pular1
       
             End If
       
        Next LinVend

Pular1:
   
           shtPatio.Range(Cells(LinPat, 2), shtPatio.Cells(LinPat, 7)).Select
   
           Selection.Delete Shift:=xlUp
    
          LinPat = LinPat - 1
   
         End If
        Next LinPat

  
      Range("B4:G4").Select
         Selection.Copy

 
       Range("B4:G21").Select
 
       Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 
       SkipBlanks:=False, Transpose:=False
 
       Application.CutCopyMode = False
        Cells(4, 1).Select
End Sub


https://forms.gle/fELg3VQzbBcryyTV6


4 - Como formatar células com VBA? ( Parte 1 )

https://youtu.be/RoKvG-SNue0
CÓDIGOS:
Sub FormatarNotas()
        Set shtNotas = Sheets("Notas")

       For Lin = 4 To 23
             Application.Wait Now + TimeValue("00:00:01")

             If shtNotas.Cells(Lin, 4).Value > 14 Then
                   shtNotas.Cells(Lin, 4).Font.ColorIndex = 5
                  shtNotas.Cells(Lin, 4).Font.Bold = True
             End If

              If shtNotas.Cells(Lin, 4).Value < 15 Then
                   shtNotas.Cells(Lin, 4).Font.ColorIndex = 3
                   shtNotas.Cells(Lin, 4).Font.Bold = True
             End If
       Next Lin

      Cells(4, 1).Select
End Sub
Imagem com os códigos das cores:



5 - Como formatar células com VBA? ( Parte 2 )

https://youtu.be/ciXl3CVaZTk
CÓDIGOS:
Sub FormatarNotas()
      Set shtNotas = Sheets("Notas")

      For Lin = 4 To 23
              If shtNotas.Cells(Lin, 5).Value = "Inativo" Then
   
               Range(Cells(Lin, 2), Cells(Lin, 5)).Interior.ColorIndex = 45
  
         End If

   
        If shtNotas.Cells(Lin, 4).Value > 14 Then
    
             shtNotas.Cells(Lin, 4).Font.ColorIndex = 5
     
            shtNotas.Cells(Lin, 4).Font.Bold = True
     
       End If

    
       If shtNotas.Cells(Lin, 4).Value < 15 Then
    
            shtNotas.Cells(Lin, 4).Font.ColorIndex = 3
   
             shtNotas.Cells(Lin, 4).Font.Bold = True
   
        End If
       Next Lin

     Cells(4, 1).Select
End Sub 



6 - Como deletar várias linhas a partir de uma determinada linha? 

https://youtu.be/64XmivlRNdg
CÓDIGOS:
Sub ApagarLinhas1()
       Set shtNotas = Sheets("Notas")
       NuLin = shtNotas.Range("G4").Value

       Set CelIni = Cells(7, 1)
       Set CelFim = Cells(6 + NuLin, 4)

 
      shtNotas.Range(CelIni, CelFim).Select
 
      Selection.Delete Shift:=xlUp

 
      Range("A6").Select
End Sub
_______________________________________
Sub ApagarLinhas2()

       Set shtNotas = Sheets("Notas")
       NumLinAp = shtNotas.Range("G4").Value

 
     Lin = 1
 
          Do While Lin < NumLinAp + 1
  
               Rows(7).Select
   
              Selection.Delete Shift:=xlUp
   
              Lin = Lin + 1
   
        Loop
       Range("A6").Select
End Sub 



7 - Como deletar várias linhas a partir de uma determinada linha?

https://youtu.be/9HG_Wkcgw2c
CÓDIGOS:
Sub Preencher01()
    Lin = 7
    Do While Cells(Lin, 1).Value <> ""
          If Cells(Lin + 1, 1).Value <> "" And Cells(Lin, 2).Value <> "" And Cells(Lin + 1, 2).Value = "" Then       
              Range(Cells(Lin, 2), Cells(Lin, 5)).Select
              Selection.Copy
       
              Range(Cells(Lin + 1, 2), Cells(Lin + 1, 5)).Select
              ActiveSheet.Paste
              Selection.Font.ColorIndex = 3       
          End If
       Lin = Lin + 1
    Loop
 
    Range("F1").Select
    Application.CutCopyMode = False
End Sub




8 - Entre abas, copiar e colar somente última linha:

https://youtu.be/cf06YbSjnLw
CÓDIGOS:
Sub Trans_Dados01()
    Dim ULin As Integer
    Dim shtTabA As Worksheet
    Dim shtTabB As Worksheet
    Dim shtTabC As Worksheet
     
    Set shtTabA = Sheets("Tabela A")
    Set shtTabB = Sheets("Tabela B")
    Set shtTabC = Sheets("Tabela C")
      
    'Copiando e colando de A para C

    shtTabA.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin).Select
    Selection.Copy
   
    shtTabC.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteValues
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteFormats
   
    'Copiando e colando de B para C

    shtTabB.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin).Select
    Selection.Copy
  
    shtTabC.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteValues
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteFormats
   
    Application.CutCopyMode = False
    Range("A1").Select  
End Sub

_______________________________________
Sub Trans_Dados02()
    Dim ULin As Integer
    Dim shtTabA As Worksheet
    Dim shtTabB As Worksheet
    Dim shtTabC As Worksheet
     
    Set shtTabA = Sheets("Tabela A")
    Set shtTabB = Sheets("Tabela B")
    Set shtTabC = Sheets("Tabela C")
      
    'Copiando e colando de A para C

    shtTabA.Activate
    ULin = Range("A1048576").End(xlUp).Row
   
    LinC = 6
    Do While LinC < 2001
        If shtTabA.Cells(ULin, 1).Value = shtTabC.Cells(LinC, 1).Value Then
             MsgBox "O ultimo dado da tabela A já existe em C. Clique em OK para continuar!"
             Range("A1").Select
             GoTo PularParaB
        End If
       LinC = LinC + 1
    Loop
      
    Rows(ULin).Select
    Selection.Copy
    Range("A1").Select
   
    shtTabC.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteValues
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteFormats
   
    'Copiando e colando de B para C

PularParaB:
    shtTabB.Activate
    ULin = Range("A1048576").End(xlUp).Row
   
    LinC = 6
    Do While LinC < 2001
       If shtTabB.Cells(ULin, 1).Value = shtTabC.Cells(LinC, 1).Value Then
           MsgBox "O ultimo dado da tabela B já existe em C. Clique em OK para continuar!"
           Range("A1").Select
           GoTo PularParaFim
       End If
       LinC = LinC + 1
    Loop
   
    Rows(ULin).Select
    Selection.Copy
    Range("A1").Select
  
    shtTabC.Activate
    ULin = Range("A1048576").End(xlUp).Row
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteValues
    Rows(ULin + 1).PasteSpecial Paste:=xlPasteFormats
   
PularParaFim:
    Application.CutCopyMode = False
    shtTabC.Activate
    Range("A1").Select  
End Sub




9 - Como gerar números aleatórios no VBA?

https://youtu.be/oBDqoXAGjEA
CÓDIGOS:
Sub Aleatório1()   
       ActiveSheet.Range("D9").Value = Int((100 * Rnd) + 1)

End Sub
_______________________________________
Sub Aleatório2()
       Dim N As Integer
       N = Range("I9").Value   
       ActiveSheet.Range("K8").Value = Int((N * Rnd) + 1)

End Sub
_______________________________________ 
Sub Aleatório3()
      Dim N, N01, N02, N03, N04, N05 As Integer
      N = 10       
      ActiveSheet.Range("Q09").Value = Int((N * Rnd) + 1)
      ActiveSheet.Range("Q10").Value = Int((N * Rnd) + 1)
Subir1:
       N01 = Range("Q09").Value
      N02 = Range("Q10").Value
      If N02 = N01 Then
         ActiveSheet.Range("Q10").Value = Int((N * Rnd) + 1)
           If N01 = N02 Then
              GoTo Subir1
           End If
      End If
   
      ActiveSheet.Range("Q11").Value = Int((N * Rnd) + 1)
Subir2:
      N03 = Range("Q11").Value
      If (N03 = N01 Or N03 = N02) Then
         ActiveSheet.Range("Q11").Value = Int((N * Rnd) + 1)
           If (N03 = N01 Or N03 = N02) Then
                GoTo Subir2
           End If
      End If

      ActiveSheet.Range("Q12").Value = Int((N * Rnd) + 1)
Subir3:
      N04 = Range("Q12").Value
      If (N04 = N01 Or N04 = N02 Or N04 = N03) Then
           ActiveSheet.Range("Q12").Value = Int((N * Rnd) + 1)
           If (N04 = N01 Or N04 = N02 Or N04 = N03) Then
                GoTo Subir3
           End If
      End If
   
      ActiveSheet.Range("Q13").Value = Int((N * Rnd) + 1)
Subir4:
      N05 = Range("Q13").Value
      If (N05 = N01 Or N05 = N02 Or N05 = N03 Or N05 = N04) Then
             ActiveSheet.Range("Q13").Value = Int((N * Rnd) + 1)
             If (N05 = N01 Or N05 = N02 Or N05 = N03 Or N05 = N04) Then
                  GoTo Subir4
             End If
      End If

End Sub



10 - é possível associar uma barra de rolagem a um combobox?

https://youtu.be/PGuhin8ELKI
CÓDIGOS:
Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Address = "$F$2" Then
          Range("A1").Value = Range("F2").Value
      End If
End Sub

_______________________________________
Private Sub Combo_01_Change()
      Range("A1").Value = Combo_01
End Sub




https://www.explorarexcel.com/p/11-excel-variedades.html