Retornar códigos começando por AUX

2024 - VBA & Macros

Post Recente por danielsafreire 12 anos atrás

3 Posts

2 Usuários

0 Reactions

1,010 Visualizações

RSS

danielsafreire

(@danielsafreire)

Posts: 15

Active Member

Topic starter

Bom dia a todos

Tentei procurar alguma solução parecida com o que eu quero na busca do fórum mas não encontrei.

O que eu queria é o seguinte:
Na minha pasta de trabalho terei várias planilhas de composição de preço (orçamento de obras) e em algumas delas pode aparecer o código AUX001, AUX002, etc... a partir da linha 32, na coluna B. Por exemplo, supondo que tenho 3 planilhas (PLAN1, PLAN2 E PLAN3). Na PLAN1 aparece o código AUX001 na célula B32 e AUX003 na célula B33. Na PLAN2 aparece o código AUX003 novamente, na célula B34. Na PLAN3 aparece uma vez o código AUX122 na célula B36. Tudo isso hipoteticamente.
Diante do exposto, preciso de uma macro que buscasse todos esses códigos que começam com AUX a partir da linha 32 na coluna B, por toda a pasta de trabalho, e os listasse na coluna D, em uma planilha chamada "INDICE". E claro, listasse os códigos sem repeti-los.

Obrigado,

Daniel

Postado : 12/06/2013 7:17 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Daniel, montei um exemplo simples (anexo).
Caso o resultado não seja o esperado, indique as inconsistências.

Código:

Sub AuxX()

Dim i, j As Integer
Dim lin, flin, elin As Long

i = 1
j = Sheets.Count - 1
elin = 2
lin = 32

Range("D2:D1000").ClearContents

Do While i <= j

flin = Sheets(i).Range("B65536").End(xlUp).Row
Do While lin <= flin
If Mid(Sheets(i).Cells(lin, 2), 1, 3) <> "AUX" Then
lin = lin + 1
ElseIf Application.WorksheetFunction.CountIf(Range("D:D"), Sheets(i).Cells(lin, 2)) > 0 Then
lin = lin + 1
Else
Cells(elin, 4) = Sheets(i).Cells(lin, 2)
lin = lin + 1
elin = elin + 1
End If
Loop
i = i + 1
lin = 32
Loop

End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 12/06/2013 10:13 am