Excel Substituir Caracteres por Outros VBA

[Neodenn]

Sou iniciante no VBA e procuro uma solução para substituir certos Caracteres da celula D:4 (Que copia o Valor da celula D:3 ).
Por exemplo:

 

Se digitado na celula D4:                2100"espaço"400-400  (2100 400-400) 
A Celula D5 deverá escrever:        *2100mm "espaço" *Base "espaço" 400mm "espaço"  + *? Prat. "espaço" 400

Em Resumo:                                   *2100mm *Base 400mm + *? Prat. 400mm

 

Essa substituição se deve para facilitar a pesquisa de mais de 1 criterio em um filtro.
Caracteres como * e ? são caracteres coringa, podendo expandir resultado.

 

Tentei um codigo aqui, mas está dando erro:

'----------------------------------------------------------------------------------------------------------------------------------------------------------------

<Sub IsAltBsPrat()
Dim cell As Range

Worksheets("MENU").Activate

If Worksheets("MENU").Range("D3").Value <> "" Then Range("D4") = "*" & Worksheets("MENU").Range("D3").Value

Dim fnd As Variant
Dim rplc As Variant

fnd = " "
rplc = "mm *Base "

Dim fnd1 As Variant
Dim rplc1 As Variant

fnd1 = "-"
rplc1 = "mm + *? Prat. "

 

    Worksheets("MENU").Range("D4").Value.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    Worksheets("MENU").Range("D4").Value.Replace what:=fnd1, Replacement:=rplc1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

End Sub>
'-------------------------------------------------------------------------------------------------------------------------------

 

 

Desde já muito grato, preciso apenas de um norte.

Obs: o Erro em questão é o '424' - O objeto é obrigatório...

Em 03/09/2021 às 17:22, Neodenn disse:

Sou iniciante no VBA e procuro uma solução para substituir certos Caracteres da celula D:4 (Que copia o Valor da celula D:3 ).
Por exemplo:

 

Se digitado na celula D4:                2100"espaço"400-400  (2100 400-400) 
A Celula D5 deverá escrever:        *2100mm "espaço" *Base "espaço" 400mm "espaço"  + *? Prat. "espaço" 400

Em Resumo:                                   *2100mm *Base 400mm + *? Prat. 400mm

 

Essa substituição se deve para facilitar a pesquisa de mais de 1 criterio em um filtro.
Caracteres como * e ? são caracteres coringa, podendo expandir resultado.

 

Tentei um codigo aqui, mas está dando erro:

'----------------------------------------------------------------------------------------------------------------------------------------------------------------

<Sub IsAltBsPrat()
Dim cell As Range

Worksheets("MENU").Activate

If Worksheets("MENU").Range("D3").Value <> "" Then Range("D4") = "*" & Worksheets("MENU").Range("D3").Value

Dim fnd As Variant
Dim rplc As Variant

fnd = " "
rplc = "mm *Base "

Dim fnd1 As Variant
Dim rplc1 As Variant

fnd1 = "-"
rplc1 = "mm + *? Prat. "

 

    Worksheets("MENU").Range("D4").Value.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    Worksheets("MENU").Range("D4").Value.Replace what:=fnd1, Replacement:=rplc1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

End Sub>
'-------------------------------------------------------------------------------------------------------------------------------

 

Tentativa 2

 

 

<

Worksheets("MENU").Activate
'
'
'If Worksheets("MENU").Range("D3").Value <> "" Then Range("D4") = "*" & Worksheets("MENU").Range("D3").Value
'

Dim cell As Range   ' Create object variable.

For Each celula In Range("D3")                              ' APROXIMADA

Next                                                           ' "

Dim fnd As Variant
Dim rplc As Variant

fnd = " "
rplc = "mm *Base "

Dim fnd1 As Variant
Dim rplc1 As Variant

fnd1 = "-"
rplc1 = "mm + *? Prat. "

    cell.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

    cell.Replace what:=fnd1, Replacement:=rplc1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

End Sub
>

Em 03/09/2021 às 17:22, Neodenn disse:

 

Desde já muito grato, preciso apenas de um norte.

Obs: o Erro em questão é o '424' - O objeto é obrigatório...

 

[RafaVillani]

@Neodenn Olá, creio que o código possa ser um pouco mais simples do que a forma como você esta tentando, veja se lhe atende dessa forma.

 

Dim Texto As String, A() As String, B() As String
Texto = Sheet1.Cells(4, 4)
A() = Split(Texto, " ")
B() = Split(A(1), "-")

Sheet1.Cells(5, 4) = "*" & A(0) & " *Base " & B(0) & "mm " & "+*? Prat. " & B(1)

 

Segue um modelo que criei.

 

Se a resposta foi útil clique em curtir, se solucionou sua dúvida marque esta resposta como solução.

 

Abraços

 

RafaVillani

Forum Modelo Neodenn.rar

[Neodenn]

@RafaVillani Show de Bola Cara, funcionou 100%, Descobri também que minha planilha estava corrompida, pois tinha colocado o seu código e estava dando errado. Bastou criar outra planilha e copiar os códigos.

Obrigado mesmo, ajudou muito!

[DJunqueira]

Será q uma função simples em D5 não dava conta?

 

="*"&ESQUERDA(D4;4)&"mm *Base "&EXT.TEXTO(D4;6;3)&"mm + *? Prat. "&DIREITA(D4;3)&"mm"