MColucci

Conseguiram uma solução pra mim, obrigado Considerando que os códigos estejam na coluna "G", ficaria assim: Sub OrganizaTextos() Dim X, r As Range, rng As Range, r1 As Range, r2 As Range, k As Long, v As Long Application.ScreenUpdating = False [K:O] = "" For Each rng In Range("G2:G" & Cells(Rows.Count, 7).End(3).Row) X = Split(rng.Value, "/") [L1].Resize(UBound(X) + 1).Value = Application.Transpose(X) If [L2] = "" Then rng.Offset(, 4).Value = [L1]: GoTo jump2 Range("L1:L" & Cells(Rows.Count, 12).End(3).Row).RemoveDuplicates Columns:=1, Header:=xlNo For v = 1 To Cells(Rows.Count, 12).End(3).Row If Left(Cells(v, 12), 1) = 9 Then Cells(v, 12).Clear: GoTo jump1 Else Select Case Left(Cells(v, 12), 3) Case "BPO": k = 8 Case "ALQ": k = 7 Case "ALT": k = 6 Case "RAC": k = 5 Case "SPA": k = 4 Case "LPP": k = 3 Case "LPJ": k = 2 Case "LPA": k = 1 Case Else: k = 0 End Select End If If k = 0 Then Cells(Rows.Count, 14).End(3)(2, 2) = Mid(Cells(v, 12), Len(Cells(v, 12)) - 1, 1) Cells(v, 12).Cut Cells(Rows.Count, 14).End(3)(2) Else Cells(Rows.Count, 12).End(3)(2, 2) = k Cells(v, 12).Cut Cells(Rows.Count, 12).End(3)(2) End If jump1: Next v Range("L:O").SpecialCells(4).Delete Range("L1:M" & Cells(Rows.Count, 12).End(3).Row).Sort Key1:=[M1], Key2:=[L1], Order1:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers Range("N1:O" & Cells(Rows.Count, 14).End(3).Row).Sort Key1:=[O1], Key2:=[N1], Order1:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers If [N1] <> "" Then Set r1 = Range("N1:N" & Cells(Rows.Count, 14).End(3).Row) If [L1] <> "" Then Set r2 = Range("L1:L" & Cells(Rows.Count, 12).End(3).Row) If r1 Is Nothing Then rng.Offset(, 4).Value = WorksheetFunction.TextJoin("/", True, r2) ElseIf r2 Is Nothing Then rng.Offset(, 4).Value = WorksheetFunction.TextJoin("/", True, r1) Else: rng.Offset(, 4).Value = WorksheetFunction.TextJoin("/", True, r1) & "/" & WorksheetFunction.TextJoin("/", True, r2) End If jump2: [L:O] = "": Set r1 = Nothing: Set r2 = Nothing Next rng End Sub

Retire o q eu disse kkkk não deu certo, preciso da macro infelizmente

Poderiam cancelar esse tópico por favor? Achei uma alternativa mais fácil sem precisar da macro

Boa noite, anexei 2 tabelas de exemplo onde eu gostaria de organizar através de macro as "LOCAÇÕES" da coluna "B" seguindo alguns critérios: * As iniciais "AL...", "DCA...", "DCS...", "SPA...", "RAC..." e "BPOINT" são prefixos ou palavras que não variam - Locações repetidas dentro da mesma célula deverão ser unificadas (ou apagada a duplicata) - Locações que iniciam com "9" seguido de vários números deverão ser apagadas - No final se sobrar "/" deverá ser apagada - Caso estejam presentes, as locações que deverão ser movidas para o final da célula serão essas na respectiva ordem: BPOINT (último) ALQ... (penúltimo) ALT... (antepenúltimo) RAC... (pré-antepenúltimo) SPA... (antes do pré-antepenúltimo) - O restante das locações deverá ser movido para o começo da célula, em ordem alfabética de acordo com a penúltima letra Ex.: Desorganizadas: BPOINT/ALF01F1/ALH02D1/BPOINT/ALQ12A1/ALH02D1/ SPA05B/BPOINT/DCA036C1/DCA036A2/DCA036E1/ALQ12E1/ALT27D3 Organizadas: ALH02D1/ALF01F1/ALQ12A1/BPOINT DCA036A2/DCA036C1/DCA036E1/SPA05B/ALT27D3/ALQ12E1/BPOINT (Eu pintei as letras apenas pra melhor visualização dos critérios aplicados) Agradeço muito desde já quem puder me ajudar nesse desafio. ITEM LOCAÇÃO 10763380 ALT48D1/ALT48D2/DCA001F1/DCA001E1/ALT48D3/DCA001E3/DCA001F3/ 15396678 ALT19A3/DCS018E1/DCS018D1/DCS018C1/DCS018E2/ALT62G1 15432208 SPA15A/ALQ08A2/DCS028B1/DCS028B2/ALT41A3 15432210 DCA028E1/ALT43G1/ALT42D1/ALT42A1/ALT37G3 15396704 93300001/BPOINT/ALT44A3/DCA034B1/SPA03A/DCA034A1/BPOINT/DCA034A2 10763376 SPA05B/BPOINT/DCA036C1/DCA036A2/DCA036E1/ALQ12E1/ALT27D3 ITEM LOCAÇÃO 10788155 ALD21A2/BPOINT/RAC2SVC1 12092080 ALQ01B2/BPOINT/ALE01F4/ 12065932 BPOINT/ALF01F1/ALH02D1/BPOINT/ALQ12A1/ALH02D1/ PPN00698 90056896/SPA01A/ALF01A2 15344639 RAC2SVC1/ALF01J1/ALB08E3 10810293 SPA01B/ALF03A2/ 10863947 ALG04C4/ALG04C4/ 12198556 90057421/ALL01J4/SPA08B/ 15470987 AST29D1/ALQ12A1/SPA04B

Achei a solução! Bastava uma função "If" a mais, obrigado Private Sub CommandButton1_Click() Dim Sh As Worksheet Dim i As Long If txtQtd = "" Then txtQtd.SetFocus Else Set Sh = Worksheets("Teste") i = 4 Qtd = txtQtd listTempo.Clear With Me.listTempo Do Until Sh.Cells(i, 4).Value = "" If Not Sh.Cells(i, 4).EntireRow.Hidden Then .AddItem Sh.Cells(i, 3).Value .List(.ListCount - 1, 1) = Sh.Cells(i, 4).Value .List(.ListCount - 1, 2) = Sh.Cells(i, 5).Value .List(.ListCount - 1, 3) = Sh.Cells(i, 6).Value .List(.ListCount - 1, 4) = Sh.Cells(i, 7).Value .List(.ListCount - 1, 5) = Qtd End If i = i + 1 Loop End With End If End Sub

Boa noite, quero listar os dados de uma tabela em uma ListBox, mas quando eu filtro a tabela ele continua mostrando tudo, mesmo os dados filtrados, como eu posso resolver isso? Private Sub CommandButton1_Click() Dim Sh As Worksheet Dim i As Long If txtQtd = "" Then txtQtd.SetFocus Else Set Sh = Worksheets("Teste") 'Primeira linha com valores (sem filtro na tabela) i = 4 Qtd = txtQtd listTempo.Clear With Me.listTempo Do Until Sh.Cells(i, 4).Value = "" .AddItem Sh.Cells(i, 3).Value .List(.ListCount - 1, 1) = Sh.Cells(i, 4).Value .List(.ListCount - 1, 2) = Sh.Cells(i, 5).Value .List(.ListCount - 1, 3) = Sh.Cells(i, 6).Value .List(.ListCount - 1, 4) = Sh.Cells(i, 7).Value .List(.ListCount - 1, 5) = Qtd i = i + 1 Loop End With End If End Sub

Sub NúmerosXNomes() Dim r1 As Range, r2 As Range, rng1 As Range, rng2 As Range Set rng1 = Sheets("Planilha A").Range("C2:C" & Sheets("Planilha A").Cells(Rows.Count, 3).End(3).Row) Set rng2 = Sheets("Planilha B").Range("A2:A" & Sheets("Planilha B").Cells(Rows.Count, 1).End(3).Row) rng2.Offset(, 1).Value = "" For Each r1 In rng1 Set r2 = rng2.Find(r1.Value) If Not r2 Is Nothing Then r2.Offset(, 1).Value = Trim(r2.Offset(, 1).Value & " " & r1.Offset(, -2).Value) Next r1 End Sub Consegui com esse código, obrigado! Ah, desculpa ter postado imagem, eu devia ter postado a planilha

Boa noite, poderiam por favor me ajudar a preencher a coluna B (da Planilha B) através de vba? Planilha A: Planilha B (com os NÚMEROS unificados): Seria exibir a quais NOMES pertencem os NÚMEROS da Planilha B, através das informações da Planilha A, separando eles com 2 "espaços", por exemplo.

Boa noite, tive uns probleminhas, mas consegui voltar aqui Testei a adaptação, funcionou mesmo, muitíssimo obrigado, você é o cara

Tenho uma TextBox para digitar valores em R$ Achei esse código na internet que funcionou muito bem para a função que eu queria, mas não está aceitando digitar números do NumPad, só aceita os números que ficam em cima das letras no teclado. Se eu incluo exceção para os códigos de teclas do NumPad ele buga e não funciona direito. Como posso consertar isso? Private Sub txtValorCP_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim zTemp As String txtValorCP.TextAlign = fmTextAlignRight If IsNumeric(Chr(KeyCode)) Or KeyCode = 8 Then If txtValorCP.Text <> "" Then zTemp = txtValorCP.Text & IIf(KeyCode <> 8, Chr(KeyCode), "") zTemp = Right(zTemp, Len(zTemp) - 2) zTemp = Replace(zTemp, ".", "") zTemp = Replace(zTemp, ",", "") If KeyCode = 8 Then If Len(zTemp) > 3 Then zTemp = Left(zTemp, Len(zTemp) - 1) Else zTemp = "0" & Left(zTemp, Len(zTemp) - 1) End If End If zTemp = Left(zTemp, Len(zTemp) - 2) & "." & Right(zTemp, 2) Else zTemp = "0.0" & IIf(KeyCode <> 8, Chr(KeyCode), "0") End If txtValorCP.Text = Format(Val(zTemp), "R$ ###,##0.00") KeyCode = 0 Else If KeyCode <> 13 And KeyCode <> 9 And KeyCode <> 40 And KeyCode <> 38 Then KeyCode = 0 End If End Sub

Funcionou perfeito, muito obrigado!

Pode ser no caso do exemplo: 5 colunas. Na prática vão ser mais, vão até a coluna "Q"

Boa noite, é que a pessoa que está precisando vai executar essa rotina e entre outras com uma frequência grande, todas de umas vez, fazer essa formatação manualmente tomaria um tempo do qual ela não tem muito. Vou colocar em uma macro Pessoal e criar um botão no menu pra executar

Olá, gostaria de saber como formatar em VBA uma planilha quando os valores nela forem diferentes, vou mostrar um exemplo prático: Eu gostaria q nessa tabela alterasse por exemplo a borda inferior da linha em que o nome muda, desse jeito: Sei que no Excel bastaria eu colocar =D2=D3 pra chegar em FALSO ou VERDADEIRO e assim filtrar e formatar como eu quisesse, mas em VBA não estou sabendo como fazer Obs.: seria uma tabela com quantidade indefinida de linhas. Se puderem me ajudar agradeço.