Ir ao conteúdo

Macro CTRL+C CTRL+V


alison.rm

Posts recomendados

Postado

Queridos, gostaria de solucionar um problema com Macro no Excel:

E simples, mas não estou conseguindo. E para copiar o conteúdo de uma célula e inserir em outra sem sobrepor, apenas acrescentando no final do conteúdo, e repetir com a célula abaixo.

Ex:

cel A1 = "vamos"

cel B1 = "fazer"

Quero que na cel A1 fique "vamos fazer"

(faço tudo com o teclado porque é uma macro com referência relativa)

>Entrar na célula ATUAL (no caso estará selecionada a B1): atalho F2

>Copiar o conteúdo da B1 (atalho CTRL+SHIFT+HOME e CTRL+C)

>ESC para sair da edição > seta p/ esquerda para poder

>Entrar na célula A1 (atalho F2)

>ESPAÇO

>CTRL+V

>TAB

>SETA PRA BAIXO

>REPETIR (agora fará na linha de baixo: B2)

O problema que a macro está gravando o conteúdo A1 "fazer", e cola sempre esse conteúdo nas próximas execuções, mas gostaria que copiasse o conteúdo da próxima célula B2,B3,B4... que sempre terá textos diferentes.

Agradeço a ajuda.

Postado

Use o código abaixo:

Sub copiar()
'executa em todas as células preenchidas na coluna A
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
'valor de A = valor de A + espaço + valor de B
Cells(i, 1).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value
Next i
End Sub

Postado
Use o código abaixo:

Sub copiar()
'executa em todas as células preenchidas na coluna A
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
'valor de A = valor de A + espaço + valor de B
Cells(i, 1).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value
Next i
End Sub

jeffsilveira,

Muito obrigado pela instrução, realmente está perfeito aqui, que facilidade.

Se não for abusar, eu usarei essa macro pra resolver uma coisa que não tinha conseguido em outra macro (tenho que usar duas macros pra resolver uma coisa só):

Observe:

clipul.jpg

A ideia é juntar o conteúdo das células 1932 e 1933, pois é um descritivo apenas.

Observe que a célula B1933 está em branco, e então fiz assim:

>nesta célula (e em todas em branco da coluna B) coloque o nome "xxx" (usei o autofiltro e colei em todas em branco)

>inserir mais uma coluna deslocando o conteúdo da B para a C

>criei uma macro (ref relativa, claro) pra:

-procurar pela expressão "xxx"

-recortar o conteúdo da célula a esquerda e colar em cima a direita(no caso A1933 para B1932) e apagar a linha abaixo (no caso A1933)

>aí veio sua instrução: juntar as duas células (A1933 e B1932).

Há como fazer uma macro apenas?

Muito obrigado.

Postado

Rapaz, sua planilha está mal construída na verdade. Claro que tem como usar apenas uma macro, e não é difícil.

Por favor, mande uma cópia da planilha em sendspace.com ou similar para que possamos montar a macro adequada e resolver essa questão.

Abraços.

Postado
Rapaz, sua planilha está mal construída na verdade. Claro que tem como usar apenas uma macro, e não é difícil.

Por favor, mande uma cópia da planilha em sendspace.com ou similar para que possamos montar a macro adequada e resolver essa questão.

Abraços.

jeffsilveira, segue o link:

http://www.sendspace.com/file/j648y7

O arquivo ficou muito grande, não sei porque. Está em RAR.

Observe que na Planilha EXPORTADA DE TXT o que eu preciso é apenas o descritivo dos itens, preços e quantidades vendidas. Na linha 208 você vê que há quebra de linha por causa do descritivo extenso, e que a linha 209 fica apenas com "UNID:" e o resto em branco. É essa quebra que preciso resolver.

Na Planilha MACRO LIMPA QUEBRA DE LINHA eu fiz uma macro que resolveu em parte o problema (fiz uma limpeza também).

Na RESTANTE SEM QUEBRA coloquei o restante da listagem sem a quebra, que não precisa fazer nada.

Na seguinte apliquei a sua macro: agora dá pra juntar os itens, fazer a média de preço e a quantidade vendida, pois os itens se repetem muito (isso faço como Access).

Agradeço desde já a ajuda.

Muito obrigado!

Postado

Alison, com certeza existe um jeito mais fácil de fazer, mas esse comando abaixo faz o serviço diretamente na planilha 'exportado em txt', faça o teste.

Sub corrigir()
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
'volta para a linha de cima
j = j - 1
End If
'condição para não explodir:
'se 2 células para baixo em B for vazia
If Cells(j + 2, 3).Value = "" Then
'pára o procedimento
Exit For
End If
Next j
Application.ScreenUpdating = True
End Sub

Postado
Alison, com certeza existe um jeito mais fácil de fazer, mas esse comando abaixo faz o serviço diretamente na planilha 'exportado em txt', faça o teste.

Sub corrigir()
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
'volta para a linha de cima
j = j - 1
End If
'condição para não explodir:
'se 2 células para baixo em B for vazia
If Cells(j + 2, 3).Value = "" Then
'pára o procedimento
Exit For
End If
Next j
Application.ScreenUpdating = True
End Sub

Jeito mais fácil? Está ótimo assim... com esse procedimento poupar muito tempo de trabalho.

Muito obrigado pela ajuda e desculpe o incômodo. Vou me dedicar mais a aprender Macro, facilita muito...

Novamente muito obrigado!

Att, Alison.

Postado

Altere para esse abaixo, mudei a condição anti-estouro!

Sub corrigir()
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
'condição para não estourar:
'se j alcançar o limite
If j = Cells(Rows.Count, 1).End(xlUp).Row + 1 Then
'pára o procedimento
Exit For
Else
'senão volta para a linha de cima
j = j - 1
End If
End If
Next j
Application.ScreenUpdating = True
End Sub

Postado

Falei que tinha jeito melhor! O mestre Osvaldo me deu uma dica infalível: percorrer o caminho de baixo para cima.

Agora a macro roda perfeito e não sobram células!

Sub corrigir()
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
End If
Next j
Application.ScreenUpdating = True
End Sub

Postado

Ola pessoal,

Desculpem reabrir o topico, mas estou com pequeno problema com minha planilha para executar a Macro para copiar dados de uma planinha (cadastro) para panilha (visão geral) e gostaria da ajuda de vocês se possível.

Como podem ver, existem 3 planilhas CADASTRO / CONSULTA / VISÃO GERAL

Os dados que eu digitar na planilha Cadastro, ao clicar no botão Cadastrar, quero que seja inserido na planilha Visão Geral da seguinte forma:

Acrescenta-se mais um linha, e copia os dados da planilha Cadastro para Visão Geral nos seus respectivo campos, NOME=NOME, ENDEREÇO=ENDEREÇO, ETC......

Até a primeira parte de acrescentar a linha vai bem, depois da erro de depuração e aí não sei como resolver.

E por ultimo, na planilha Cadastro em Registro, há como deixar um numero em sequencia, como 1, 2, 3........ no access é a chave primaria, tem como fazer isso no excel?

Muito obrigado pela ajuda.

Abs.

Postado

Lars, analisando sua planilha entendo que seria melhor usar um userform para cadastrar um novo árbitro, contendo os mesmos conteúdos que sua planilha Cadastro.

Eliminaria aba desnecessária e ficaria mais fácil cadastrar, buscar, editar e excluir.

Veja nesse tópico a planilha que fiz para tesouraria, pode achar alguma aplicabilidade para seu conteúdo. Abraços.

http://forum.clubedohardware.com.br/planilha-tesouraria-clubes/1038371

Ou tente adaptar essa agenda telefônica que estou montando, simples mas prática.

http://www.sendspace.com/file/mcbaih

Postado

Ola Jeff,

Show de bola esses forms heim, o grande problema é não manjo nadica de nada de forms. Sem dúvida que dessa forma é bem mais fácil e pratico, vou tentar achar alguma coisa nesse sentido e aprender como se faz.

Muito obrigado.

abs.

Postado
Falei que tinha jeito melhor! O mestre Osvaldo me deu uma dica infalível: percorrer o caminho de baixo para cima.

Agora a macro roda perfeito e não sobram células!

Sub corrigir()
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
End If
Next j
Application.ScreenUpdating = True
End Sub

Ok, obrigado novamente... aproveitando gostaria de saber como colocar uma macro dentro de outra. Por exemplo, depois dessa última macro que você mandou, gostaria de "colar" essa:

Sub Macro1()

'

' Macro1 Macro

'

'

Range("A1").Select

Selection.EntireColumn.Delete

Selection.EntireColumn.Delete

Range("D1").Select

Selection.EntireColumn.Delete

Selection.EntireColumn.Delete

Selection.EntireColumn.Delete

Selection.EntireColumn.Delete

Columns("A:A").Select

ActiveWorkbook.Worksheets("27-02 A 28-03 BRUTA").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("27-02 A 28-03 BRUTA").Sort.SortFields.Add Key:= _

Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("27-02 A 28-03 BRUTA").Sort

.SetRange Range("A1:C5773")

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Cells.Select

Cells.EntireColumn.AutoFit

Rows("1:1").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A1").Select

ActiveCell.FormulaR1C1 = "DESCRITIVO"

Range("B1").Select

ActiveCell.FormulaR1C1 = "R$"

Range("C1").Select

ActiveCell.FormulaR1C1 = "QNT"

Rows("1:1").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Selection.Font.Bold = True

Columns("B:B").EntireColumn.AutoFit

Cells.Select

Cells.EntireColumn.AutoFit

Columns("C:C").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Columns("B:C").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A1").Select

Selection.End(xlDown).Select

Selection.End(xlUp).Select

End Sub

-------------------------------------------------

Essa exclui as colunas A, B, F, G H e I, pois estes dados são irrelevantes; depois coloca em ordem alfabética e coloca uma linha com DESCRITIVOS, R$ e QNT. O final seria isto:

http://www.sendspace.com/file/je19bb

(não consegui postar no imageshack)

Seu que tem como fazer uma macro mais simples, mas queria saber como "colar" em numa macro existem, caso eu precise.

Novamente grato!

Postado

Para incluir um novo procedimento dentro de uma macro existente, você pode copiar o código novo (sem sub Macro() e End Sub) e colar logo após o término do procedimento atual, antes de End Sub.

Mas calma, vou arrumar esse código para você, não sabia que tinha que apagar mais dados da planilha. Amanhã passo. Abraços.

Postado
Para incluir um novo procedimento dentro de uma macro existente, você pode copiar o código novo (sem sub Macro() e End Sub) e colar logo após o término do procedimento atual, antes de End Sub.

Mas calma, vou arrumar esse código para você, não sabia que tinha que apagar mais dados da planilha. Amanhã passo. Abraços.

Hum... bom saber. Vou aguardar, muito obrigado!

Aproveitando, como colocar uma caixa de diálogo antes e após rodar a macro?

Postado

Alison, dei uma arrumada na macro e agora acho que ficou do jeito que você precisa.

Incluí coluna de total já com as fórmulas de arredondamento. Pus também uma caixa de diálogo no final.

A coluna de preços estava errada em alguns pontos, onde o R do R$ ficava na coluna anterior. Corrigi isso também.

Leia os comentários em cada procedimento para absorver melhor seu conteúdo.

O link da planilha e o código respectivo estão abaixo:

http://www.sendspace.com/file/ey7fem

Sub corrigir()
'desabilita atualização de tela
Application.ScreenUpdating = False
'PRIMEIRO CORRIGE A COLUNA 'C'
'executa no número de células preenchidas na coluna C
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
'se a célula em A estiver vazia
If Cells(i + 1, 1).Value = "" Then
'valor de C = valor de C + espaço + valor de C de baixo
Cells(i, 3).Value = Cells(i, 3).Value & " " & Cells(i + 1, 3).Value
'deleta a linha extra
Cells(i + 1, 1).EntireRow.Delete
End If
Next i
'AGORA DELETA AS LINHAS ONDE NÃO É NUMÉRICO EM 'A'
'executa no número de células preenchidas na coluna A
For j = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
'se não for numérico ou for vazio
If Not IsNumeric(Cells(j, 1).Value) Or _
Cells(j, 1).Value = "" Then
'deleta a linha
Cells(j, 1).EntireRow.Delete
End If
Next j
'POR FIM CORRIGE COLUNA DE PREÇOS
For k = 1 To Cells(Rows.Count, 4).End(xlUp).Row
'se a célula começar com cifrão
If Left(Cells(k, 4), 1) = "$" Then
'insere R e o apaga na célula à esquerda
Cells(k, 4).Value = "R" & Cells(k, 4).Value
Cells(k, 3).Value = Left(Cells(k, 3).Value, Len(Cells(k, 3)) - 1)
End If
Next k
'VAI PARA O PRÓXIMO PROCEDIMENTO
'corrige o formato da coluna E (QTDE)
Columns("E:E").NumberFormat = "0.00"
'organiza em ordem crescente
Dim LR As Long
With Sheets(1)
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
LR = .Cells(Rows.Count, 2).End(xlUp).Row
End With
With Sheets(1).Sort
.SetRange Range("C2:E" & LR)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'deleta as colunas desnecessárias
Range("F:J").EntireColumn.Delete
Range("A:B").EntireColumn.Delete
'insere cabeçalho
Rows("1:1").Insert Shift:=xlDown
'atribui nomes ao cabeçalho
Cells(1, 1) = "DESCRITIVO"
Cells(1, 2) = "R$"
Cells(1, 3) = "QTDE"
Cells(1, 4) = "TOTAL"
'centraliza e negrita
With Range("A1:D1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
'coloca fórmula na coluna TOTAL
For l = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Cells(l, 4).FormulaR1C1 = "=ROUND(RC[-1]*RC[-2],2)"
Next l
'corrige formato da coluna total
Columns("D:D").Style = "Currency"
'habilita atualização de tela
Application.ScreenUpdating = True
'mensagem de sucesso
MsgBox "Planilha alterada!", vbOKOnly, "Sucesso!"
End Sub

Abraços.

Postado

Sub Macro10()

'

' Macro10 Macro

'

'

Application.ScreenUpdating = False

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _

FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

Columns("B:B").Select

Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _

FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

Columns("C:C").Select

Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _

FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

Columns("B:B").Select

Selection.FormatConditions.Add Type:=xlTextString, String:=" sh ", _

TextOperator:=xlContains

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 49407

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = True

Selection.FormatConditions.Add Type:=xlTextString, String:=" cond ", _

TextOperator:=xlContains

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 65535

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = True

ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Add(Range _

("B2:B12578"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue. _

Color = RGB(255, 192, 0)

ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Add(Range _

("B2:B12578"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue. _

Color = RGB(255, 255, 0)

With ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort

.SetRange Range("A1:C12578")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveWindow.SmallScroll Down:=-25

MsgBox "É preciso limpar as Regras da Formatação Condicional.", vbOKOnly, "Sucesso!"

End Sub

jeffsilveira, não sei como agradecer, com sua ajuda meu trabalho ficará 1000% mais fácil, obrigado mesmo. Realmente esse universo de Macro é ótimo, pra quem tem tal conhecimento. Obrigado!

Sem querer abusar, e vendo que isso de Macro é fantástico, tenho outra planilha com um problema diferente:

http://www.sendspace.com/file/c6tjo9

Nesta tabela está assim:

ACQUAFLORA - CO 300ML DIA A DIA

ACQUAFLORA - SH ANTIOXIDANTE 300ML

ACQUAFLORA CR S/ENX CONTROLE VOL 250ML

ACQUAFLORA MASC HID INTENSIVA 250ML

Aquela outra planilha estava por ordem de produto, exemplo:

SHAMPOO ACQUAFLORA

CONDICIONADOR ACQUAFLORA

CREME S/ EX ACQUACLARA

Ok... eu tenho que colocar esta planilha em ordem de produtos, pra ficar como na anterior. Eu tinha criado uma macro +- assim:

>procurar " - CO " (onde seriam todos os condicionadores)

>recortar todas as LINHAS com " - CO " e copiar noutra planilha

>procurar por " - SH " (onde seriam todos os shampoos)

>recortar todas as LINHAS com " - SH " e copiar noutra planilha

e assim sucessivamente com todas as categorias (MAS, REP DE PONTAS, CREME TRAT, MASC TRAT)

Desta forma ficaria menos problemática pra trabalhar.

Pra você entender, eu trabalho com um Coletor (Palm) e tenho que lançar todos os produtos no programa (o Coletor já vem com o descritivo, basta apenas colocar o preço e as vendas).

Então eu teria que ir pra 3 telas diferentes: Shampoo, Cond e Creme pra lançar a marca Acquaflora tornando o trabalho lento e repetitivo, pois tenho que ir novamente pra todas as marcas.

Com essa minha macro eu ficaria na tela de Shampoo até acabar todas as marcas, depois irar pra Cond... então mudaria de tela apenas 3x

Há como facilitar isso? Se puder me ajudar com uma Macro "milagre" agradeceria muito. Tentem fazer algumas coisas mas sempre fica +-...

Desde já agradeço muito.

Att ^_^

Postado

Alison, daria para fazer se houvesse padronização na lista.

Alguns itens estão "- HID", outros "- HIDR" e "- HIDRAT".

Fora que daria confusão ao buscar SH de shampoo, pois incluiria o SH de AIRBRUSH, BLUSH, etc.

Acho que da forma como está preenchida não daria, a não ser que alguém tenha uma luz.

Entendeu?

Postado
Alison, daria para fazer se houvesse padronização na lista.

Alguns itens estão "- HID", outros "- HIDR" e "- HIDRAT".

Fora que daria confusão ao buscar SH de shampoo, pois incluiria o SH de AIRBRUSH, BLUSH, etc.

Acho que da forma como está preenchida não daria, a não ser que alguém tenha uma luz.

Entendeu?

Ok jeffsilveira, mesmo assim muito obrigado.

Talvez eu não tenha sido suficientemente claro. Eu uso duas ferramentas pra trabalhar essa listagem: Autofiltro e Formatação Condicional. No fim de semana eu posto os detalhes pra você ver, mas baseado na outra macro que você criou, esta vai ser mais simples (ou não mais trabalhosa que a outra).

Pra você ver, quando você diz

Alguns itens estão "- HID", outros "- HIDR" e "- HIDRAT".

Fora que daria confusão ao buscar SH de shampoo, pois incluiria o SH de AIRBRUSH, BLUSH, etc.

não acontece esse problema, pois eu utilizo o termo <espaço>SH<espaço>, e realmente tenho que colocar todas as expressões "- HID<espaço>", "- HIDR<espaço>" e "- HIDRAT<espaço>", mas a "fórmula" serviria para todas as listagens subsequentes, pois apenas mudariam os valores... depois explico melhor.

Obrigado!

Postado
Beleza, no aguardo dos detalhes.

Olá jeffsilveira, fiz essa macro que é +- como preciso: ficou classificada por "categoria" e depois ordem alfabética. Coloquei os valores apenas para Shampoo e Condicionador, mas depois vou acrescentar as demais (CR TRAR, MASC etc.)

Dois problemas:

1 - usei "criar macro", mas a gravação não gravou a exclusão das regras de formatação condicional para que as colunas não fiquem com cores... você verá quando rodar.

2 - a macro estava selecionado apenas o intervalo ("B2:B2578") por ser o número de linhas ativas nesta planilha, mas caso a planilha tenha mais linhas que isso ela irá ignora-las. Então editei para ("B2:B12578"), pois tenho certeza que não haverá uma planilha maior que 12578 linhas.

Estamos quase lá com aquelas dicas iniciais...

Novamente muito obrigado.

Segue a macro e arquivo (sem macro):

http://www.sendspace.com/file/sb9q50



Sub Macro10()
'
' Macro10 Macro
'

'
MsgBox "Se o nome da planilha não for 01.03.12a31.03.12_Mensal a macro não roda!", vbOKOnly, "OBS"
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.FormatConditions.Add Type:=xlTextString, String:=" sh ", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Selection.FormatConditions.Add Type:=xlTextString, String:=" cond ", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Add(Range _
("B2:B12578"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue. _
Color = RGB(255, 192, 0)
ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort.SortFields.Add(Range _
("B2:B12578"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue. _
Color = RGB(255, 255, 0)
With ActiveWorkbook.Worksheets("01.03.12a31.03.12_Mensal").Sort
.SetRange Range("A1:C12578")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-25
MsgBox "É preciso limpar as Regras da Formatação Condicional.", vbOKOnly, "Sucesso!"
End Sub

Postado

Alison, sua macro está muito confusa. Cheia de '.select'. Aprendi com o Osvaldo que quanto menos utilizar isso, melhor.

Acabei por montar outra mais intuitiva, acho que você vai pegar fácil a sequência:

Sub ajustar()
' desabilita atualização de tela
Application.ScreenUpdating = False
'informa a variável
Dim lin As Integer
' define como sendo a última linha preenchida em B
lin = Cells(Rows.Count, 2).End(xlUp).Row
' insere o tipo de produto na coluna D
For i = 2 To lin
' SHAMPOO
If Cells(i, 4) = "" Then
Cells(i, 4).FormulaR1C1 = "=IFERROR(FIND("" [COLOR="Red"]SH[/COLOR] "",RC[-2]),"""")"
End If
If IsNumeric(Cells(i, 4)) Then
Cells(i, 4) = "[COLOR="Red"]SHAMPOO[/COLOR]"
End If
' HIDRATANTE
If Cells(i, 4) = "" Then
Cells(i, 4).FormulaR1C1 = "=IFERROR(FIND("" [COLOR="Red"]HID[/COLOR]"",RC[-2]),"""")"
End If
If IsNumeric(Cells(i, 4)) Then
Cells(i, 4) = "[COLOR="Red"]HIDRATANTE[/COLOR]"
End If
' OUTRO PRODUTO
'copie aqui novo procedimento
Next i
' Organiza em ordem crescente pela coluna D
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("D2"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A2:D" & lin) 'seleciona até a última linha preenchida
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' habilita atualização de tela
Application.ScreenUpdating = True
End Sub

Veja só os itens que estão em vermelho. Para novos procedimentos, copie e altere tais informações para CRE - CREME, COND - CONDICIONADOR, etc. Veja que para hidratante não coloquei espaço após ele, assim pegou todos.

Não usei formatação condicional, acho que não é por aí.

Quanto ao número de linhas, usei a variável 'lin', explicada na macro.

A classificação está em ordem crescente, por isso após rodar o procedimento, veja que hidratante e shampoo estão na parte inferior da planilha.

Ah, e não precisa ter nome específico na aba, pois a macro roda para a aba ativa.

Veja se isso te ajuda.

Abraços.

Postado
Alison, sua macro está muito confusa. Cheia de '.select'. Aprendi com o Osvaldo que quanto menos utilizar isso, melhor.

Acabei por montar outra mais intuitiva, acho que você vai pegar fácil a sequência:

Sub ajustar()
' desabilita atualização de tela
Application.ScreenUpdating = False
'informa a variável
Dim lin As Integer
' define como sendo a última linha preenchida em B
lin = Cells(Rows.Count, 2).End(xlUp).Row
' insere o tipo de produto na coluna D
For i = 2 To lin
' SHAMPOO
If Cells(i, 4) = "" Then
Cells(i, 4).FormulaR1C1 = "=IFERROR(FIND("" [COLOR="Red"]SH[/COLOR] "",RC[-2]),"""")"
End If
If IsNumeric(Cells(i, 4)) Then
Cells(i, 4) = "[COLOR="Red"]SHAMPOO[/COLOR]"
End If
' HIDRATANTE
If Cells(i, 4) = "" Then
Cells(i, 4).FormulaR1C1 = "=IFERROR(FIND("" [COLOR="Red"]HID[/COLOR]"",RC[-2]),"""")"
End If
If IsNumeric(Cells(i, 4)) Then
Cells(i, 4) = "[COLOR="Red"]HIDRATANTE[/COLOR]"
End If
' OUTRO PRODUTO
'copie aqui novo procedimento
Next i
' Organiza em ordem crescente pela coluna D
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("D2"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A2:D" & lin) 'seleciona até a última linha preenchida
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' habilita atualização de tela
Application.ScreenUpdating = True
End Sub

Veja só os itens que estão em vermelho. Para novos procedimentos, copie e altere tais informações para CRE - CREME, COND - CONDICIONADOR, etc. Veja que para hidratante não coloquei espaço após ele, assim pegou todos.

Não usei formatação condicional, acho que não é por aí.

Quanto ao número de linhas, usei a variável 'lin', explicada na macro.

A classificação está em ordem crescente, por isso após rodar o procedimento, veja que hidratante e shampoo estão na parte inferior da planilha.

Ah, e não precisa ter nome específico na aba, pois a macro roda para a aba ativa.

Veja se isso te ajuda.

Abraços.

Rapaz, rodei mas não aconteceu nada...

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!