Jump to content

Recommended Posts

Posted

Boa noite.

 

Pretendo criar uma macro que faça o seguinte:

- pesquisar um determinado valor na coluna "A" de uma planilha e, caso o encontre, pesquisar outro valor apenas nas células da linha do valor encontrado na coluna A.

A primeira parte consigo fazer sem problema. Não sei é como fazer a segunda (apenas consigo procurar em toda a planilha, o que não me interessa).

Só por curiosidade, pretendo que a macro, caso não encontre o valor da coluna A, adicione o valor pretendido nessa coluna, na célula imediatamente abaixo da última preenchida.

Segue-se o códgo:

Private Sub addcrimes_Click()

Dim sourceXL As Excel.Application
Dim MANUAL As Excel.Workbook
Dim sourceSheet As Excel.Worksheet

Set sourceXL = Excel.Application
Set MANUAL = sourceXL.Workbooks.Open("C:\PROGRAMA\BDADOS.xlsm")
Set sourceSheet = MANUAL.Sheets("Bananas")

linha = macasbox
linha1 = bananasbox1.Value

MANUAL.Activate

totalregistos = Sheets("Bananas").UsedRange.Rows.Count

Sheets("Bananas").Select

With sourceSheet.Range("A1:A5000")
   If macasbox = "" Then
   Application.Visible = True
   MsgBox ("Por favor, insira um valor e volte a tentar")
   macasbox .SetFocus
   macasbox .BackColor = vbYellow
   MANUAL.Save
   MANUAL.Close
   Application.Visible = False
   Exit Sub
    Else
    Application.Visible = True
    nuipcbox.BackColor = vbWhite
    Set c = .Find(linha, LookIn:=xlValues)
        If Not c Is Nothing Then
                c.Select
                Do
                ActiveCell.Offset(0, 1).Select
                Loop Until ActiveCell = ""
                ActiveCell = Me.bananasbox1
                Me.bananasbox1= Null
                End If
            End If
    If c Is Nothing Then
    Cells(totalregistos + 1, "A") = Me.macasbox
    Cells(totalregistos + 1, "B") = Me.bananasbox1
    End If
      
    
End With

MANUAL.Save
MANUAL.Close
Application.Visible = False

Obrigado!

Cumprimentos

Posted (edited)

boa tarde deixo-te aqui um pequeno exemplo para desenvolveres.

ActiveWorkbook.Sheets("Rotas").Activate
    Set vRangeRotas = Range("B5:J3000")
    If (vRangeRotas.Cells(1, 1).value <> "") Then
            MsgBox ("Não é possivel criar rotas sem apagar as existentes")
            Exit Sub
    End If
// aonde o primeiro 1 representa a linha e o segundo a coluna : If (vRangeRotas.Cells(NumRow, NumCol).value <> "") Then 

cumpt

acao

 

resolvi  dar-te a papa toda  coloca o código na folha e percorre-o e faz as tuas alterações.


    ActiveWorkbook.Sheets("Rotas").Activate
    Set vRangeRotas = Range("B5:J3000")
    For jRow = 1 To vRangeRotas.Rows.Count 'percorre as linhas
            If (Trim(vRangeRotas.Cells(jRow, 1).value) <> "") Then  '  verifica se tem valor
                    For vCol = 2 To vRangeRotas.Columns.Count 'percorre as colunas
                            MsgBox (vRangeRotas.Cells(jRow, vCol).value) ' amostra os valores da linha

                    next vCol
            End if
    Next jRow
    Set vRangeRotas = Nothing
    ' atualiza
    Application.ScreenUpdating = True
Edited by acao
  • 3 weeks later...
Posted

Olá. Você pode fazer um segundo find pegando a linha retornada do primeiro find. Assim não precisa fazer loops.

Qualquer dúvida estou a disposição. Se tiver algum modelo de exemplo eu monto o código completo e te envio. Ai você da uma olhada.

Private Sub CommandButton1_Click()
    With Planilha1
        Set celula = .Range("A:A").Find('valor_primeira_pesquisa, , xlValues, xlWhole)
        If Not celula Is Nothing Then ' se encontrar o valor na coluna A
            coluna = .Cells(celula.Row, Columns.Count).End(xlToLeft).Column 'pega ultima coluna com dados
            Set valor = .Range(Cells(celula.Row, 1), Cells(celula.Row, coluna)).Find(valor_segunda_pesquisa, , , xlWhole) 'pesquisa na linha que foi encontrada no primeiro find
            If valor Is Nothing Then 'se não encontrar o valor na linha do primeiro find
                'escreva o código
            End If
        Else 'se não encontrou o valor da coluna A
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = valor_primeira_pesquisa
            .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = valor_segunda_pesquisa
        End If
    End With
End Sub

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.