Douken Posted March 15, 2018 at 09:19 PM Report #609790 Posted March 15, 2018 at 09:19 PM 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
acao Posted March 15, 2018 at 11:35 PM Report #609793 Posted March 15, 2018 at 11:35 PM (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 March 16, 2018 at 12:26 AM by acao
Renato MDSP Posted April 3, 2018 at 02:11 AM Report #610038 Posted April 3, 2018 at 02:11 AM 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
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now