none
Como faço uma rotina para inserir um valor em uma célula entre a linha e a coluna específica(VBA) ? RRS feed

  • Pergunta

  • Olá galera, queria saber como faço uma rotina para inserir um valor em uma célula entre uma linha e coluna específica. Ex.: Quero que na rotina ele irá pesquisar o valor do ComboBox1 na coluna A e outro valor do ComboBox2 em outra coluna qualquer, assim que ele achar os valores, ele irá selecionar a célula entre a linha do valor pesquisado na coluna A e a coluna do valor pesquisado na coluna qualquer e descarregar um valor digitado no ComboBox3. Se o valor do ComboBox1 estiver na linha 5 e o valor do ComboBox2 na coluna K, a célula onde deverá descarregar o valor de ComboBox3 será K5:

    terça-feira, 25 de novembro de 2014 18:23

Respostas

  • Dim moSheet As Excel.Worksheet
    
    Private Sub UserForm_Initialize()
      Dim l As Long
       
      'Altere aqui para adequar ao seu caso:
      Set moSheet = ThisWorkbook.Worksheets("Plan1")
       
      With moSheet
        'Preencher caixas de combinação:
        For l = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
          ComboBox1.AddItem .Cells(l, "A")
        Next l
        For l = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
          ComboBox2.AddItem .Cells(1, l)
        Next l
      End With
       
    End Sub
    
    Private Sub CommandButton1_Click()
      Dim lRow As Long
      Dim lCol As Long
      
      lRow = pMatch(ComboBox1, moSheet.Columns("A"))
      lCol = pMatch(ComboBox2, moSheet.Rows(1))
      If lRow = 0 Or lCol = 0 Then
        MsgBox "Selecione um valor válido nas caixas de combinação 1 e 2!", vbExclamation
        Exit Sub
      End If
      
      moSheet.Cells(lRow, lCol) = ComboBox3
      
      MsgBox "Registro inserido com sucesso!", vbInformation
    End Sub
    
    Private Function pMatch(vValue As Variant, _
                            vArray As Variant) As Long
      'Retorna a linha/coluna/índice de um valor encontrado numa coluna/linha/vetor.
      'Retorna 0 se elemento não for encontrado.
      Dim ret As Long
    
      On Error Resume Next
      ret = WorksheetFunction.Match(CDbl(vValue), vArray, 0)
      If ret = 0 Then ret = WorksheetFunction.Match(CStr(vValue), vArray, 0)
      On Error GoTo 0
    
      pMatch = ret
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 1 de dezembro de 2014 20:51
    Moderador