Notifications
Clear all

Substitundo texto em todas abas automaticamente.

11 Posts
4 Usuários
0 Reactions
1,847 Visualizações
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Bom dia a todos,

Estou com um problema para adaptar este codigo para minha necessidade.
Gostaria que o texto fosse substituido em todas as abas conforme o texto da coluna S.
No momento tenho que selecionar o texto que quero substituir, porem gostaria que fosse substituido automaticamente assim que a macro fosse acionada.

Por exemplo.

Se em qualquer parte da aba Comprovante constar algum texto que esteja na coluna R que seja substituido pelo texto da coluna S.
E assim sucessivamente com todas abas da planilha.

Antecipadamente agradeco.

Abracos

Fabio sp.

 
Postado : 16/03/2016 4:07 am
(@leonardo)
Posts: 81
Trusted Member
 

Olá Fabiosp,

Dá uma olhada no arquivo em anexo.

No aguardo.

 
Postado : 16/03/2016 6:00 am
(@mprudencio)
Posts: 2749
Famed Member
 

Eu posso estar maluco mas um Ctrl+U resolve

Selecione todas as abas

Com o ponteiro sobre a guia ativa botao direito do mouse Selecionar Todas as Planilhas

Ctrl + U

Texto a ser substituido

Texto substituto.

Selecione outra aba qualquer para sair da multipla seleção

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 16/03/2016 9:07 am
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Olá Leonardo boa tarde,
Agradeço a ajuda.
Testei mas não houve alteração do texto nas outras abas.
O que eu preciso eh se em qualquer aba houver texto igual da coluna R que seja substituido pelo texto da coluna S.

Abraços.

 
Postado : 16/03/2016 9:58 am
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Boa Tarde MPrudencio

Testei mas não alterou.
Agradeço a dica

Grande abraço

 
Postado : 16/03/2016 10:02 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Fábio, aquele modelo referente a outro tópico seu, não resolveria ? A rotina substitui em todas as abas.

Corrigindo texto através de macro VBA [Resolvido]
viewtopic.php?f=10&t=15798&p=81432

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

 
Postado : 16/03/2016 10:39 am
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Mauro Coutinho,

Foi a primeira coisa que tentei fazer.
Mas nesta nova planilha não esta funcionando.
Básicamente preciso fazer a mesma coisa, mas como o antigo código não funcionou tentei fazer com esse outro.
Funciona mas não faz tudo automaticamente igual o antigo.

Abraços

 
Postado : 16/03/2016 2:21 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Qdo vc selecionou a planilha as abas ficaram todas brancas???

Vc clicou em substituir tudo????

Pq sempre usei assim e sempre funcionou por isso sugeri.

Sua planilha teve essa aparencia???

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 16/03/2016 2:26 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Mauro Coutinho,

Foi a primeira coisa que tentei fazer.
Mas nesta nova planilha não esta funcionando.
Básicamente preciso fazer a mesma coisa, mas como o antigo código não funcionou tentei fazer com esse outro.
Funciona mas não faz tudo automaticamente igual o antigo.

Abraços

Não sei quais ajustes fez, mas no exemplo anterior sua lista de nomes estavam nam colunam A e B da aba de nome "Corrigido" e neste seu novo modelo os nomes estão nas colunas "R e S" da aba "Lista_De_Nomes", então seriam somente estes ajustes a fazer, teste com a rotina abaixo se é isto e veja as alterações que fiz conforme comentei acima.

Sub Loc_Substitui()
Dim sCorrigido As Worksheet
Dim sRgCorrigido As Range
Dim UltimaLinha As Long
Dim sChina, sSubstitui
Dim sSht As Worksheet

Set shtCorrigido = Sheets("Lista_De_Nomes")
UltimaLinha = shtCorrigido.Cells(Rows.Count, 18).End(xlUp).Row

'Define o Range COM AS PALAVRAS corrigidas
Set sRgCorrigido = shtCorrigido.Range("R2:" & "R" & UltimaLinha)

    'Primeiro eliminamos o caracter til(~) de todas as abas, inclusive a Corrigido
    For Each xTil In Worksheets
        Set sSht = xTil
        With sSht
            .Cells.Replace What:="~~", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False
        End With
    Next

    For Each x In Worksheets
        'Definimos para não alterar a aba com as correções
        If x.Name <> "Lista_De_Nomes" Then
            Set sSht = x
            
            'Alteramos todas as ocorrências em todas as abas menos a "Lista_De_Nomes"
            For Each y In sRgCorrigido
                sChina = y 'Coluna Palavras em Chines
                sSubstitui = y.Offset(0, 1) 'Coluna Palavra corrigida
                
                With sSht
                    .Cells.Replace What:=sChina, Replacement:=sSubstitui, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False
                End With
            Next
        End If
    Next
    
End Sub

[]s

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

 
Postado : 16/03/2016 4:23 pm
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Bom dia MPrudencio,
Agora entendi que você está dizendo..rs
Fazia isso antes mas como agora tenho várias linhas e várias abas fica complicado fazer desta forma.
Mas agradeço a sua dica caro colega.

Abraços

Qdo vc selecionou a planilha as abas ficaram todas brancas???

Vc clicou em substituir tudo????

Pq sempre usei assim e sempre funcionou por isso sugeri.

Sua planilha teve essa aparencia???

 
Postado : 17/03/2016 6:05 am
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Bom dia Mauro Coutinho,

Agradeço a sua ajuda.
Agora entendi porque não estava funcionando a macro da planilha antiga.
Na correria do dia dia não percebi que não tinha mudado o número que define aonde estão as palavras corrigidas.
Assim nunca iria funcionar mesmo. :o
Peço desculpa por minha falha.
Agora esta tudo certo.
Agradeço a sua generosidade.

Mauro Coutinho

Foi a primeira coisa que tentei fazer.
Mas nesta nova planilha não esta funcionando.
Básicamente preciso fazer a mesma coisa, mas como o antigo código não funcionou tentei fazer com esse outro.
Funciona mas não faz tudo automaticamente igual o antigo.

Abraços

Não sei quais ajustes fez, mas no exemplo anterior sua lista de nomes estavam nam colunam A e B da aba de nome "Corrigido" e neste seu novo modelo os nomes estão nas colunas "R e S" da aba "Lista_De_Nomes", então seriam somente estes ajustes a fazer, teste com a rotina abaixo se é isto e veja as alterações que fiz conforme comentei acima.

Sub Loc_Substitui()
Dim sCorrigido As Worksheet
Dim sRgCorrigido As Range
Dim UltimaLinha As Long
Dim sChina, sSubstitui
Dim sSht As Worksheet

Set shtCorrigido = Sheets("Lista_De_Nomes")
UltimaLinha = shtCorrigido.Cells(Rows.Count, 18).End(xlUp).Row

'Define o Range COM AS PALAVRAS corrigidas
Set sRgCorrigido = shtCorrigido.Range("R2:" & "R" & UltimaLinha)

    'Primeiro eliminamos o caracter til(~) de todas as abas, inclusive a Corrigido
    For Each xTil In Worksheets
        Set sSht = xTil
        With sSht
            .Cells.Replace What:="~~", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False
        End With
    Next

    For Each x In Worksheets
        'Definimos para não alterar a aba com as correções
        If x.Name <> "Lista_De_Nomes" Then
            Set sSht = x
            
            'Alteramos todas as ocorrências em todas as abas menos a "Lista_De_Nomes"
            For Each y In sRgCorrigido
                sChina = y 'Coluna Palavras em Chines
                sSubstitui = y.Offset(0, 1) 'Coluna Palavra corrigida
                
                With sSht
                    .Cells.Replace What:=sChina, Replacement:=sSubstitui, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False
                End With
            Next
        End If
    Next
    
End Sub

[]s

 
Postado : 17/03/2016 6:16 am