Excel - Script que pesquisa uma planilha por uma célula contendo texto específico e substitui o texto por um valor específico

Question

Eu quero dividir uma célula com dados em outras células com base nos dados da célula original. Os dados da célula original são assim (todo o conteúdo em uma única célula):

Field95-4,Field97-4,Field98-0,Field100-2,Field103-0,Field105-3,Field107-4,Field109-4,Field110-2,Field111-0,Field112-0,Field113-192,Field114-87,Field115-0,Field116-0,Field117-60

Deve ser dividido usando "," como um delimitador. Descobri que eu poderia fazer isso com um script:

Private Sub CommandButton1_Click()
Dim X As Variant
X = Split(Range("A1").Value, ",")
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

O resultado é assim:

Field95-4
Field97-4
Field98-0
Field100-2
Field103-0
Field105-3
Field107-4
Field109-4
Field110-2
Field111-0
Field112-0
Field113-192
Field114-87
Field115-0
Field116-0
Field117-60

Cada valor é um único token que contém duas partes divididas por um hífen; o conteúdo da célula original e seu valor de substituição. O script deve procurar uma célula contendo a primeira parte do token, a parte "fieldnumber".

Por exemplo, há uma célula contendo o texto 'Field95', e uma célula com o texto 'Field97' etc. Então eu quero substituir a primeira parte do token com a segunda parte. Portanto, para 'Field95-4', uma célula com o conteúdo 'Field95' deve ser encontrada e substituída pelo texto '4'. A célula com o conteúdo 'Field97' deve ser substituída por '4'. etc.

Este é um arquivo excel que eu enviei, para que você possa ver sobre o que é a minha pergunta. Ele contém os dados. link

Eu sei que é muito para perguntar, mas nós tentamos muito, e eu não consigo fazer isso funcionar.

Estou ansioso por suas respostas. Obrigado antecipadamente!

    

Answer 1

Assumindo que seus valores estão em um intervalo e sua pesquisa & Substituir intervalo não inclui esse intervalo , algo como isso pode funcionar (ajustar os intervalos, tente em uma cópia de seus dados) -

Sub test()
Dim X As Variant
X = Split(Range("A2").Value, ",")
Range("A2").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

Sub test2()
Application.ScreenUpdating = False
Dim strReplace As String
Dim strSearch As String
Dim i As Integer
Dim j As Integer

'Loop through cells
For Each c In Range("A2:A17")
    'Select non-blanks
    If c.Value <> "" Then
        On Error Resume Next
        'Get length of cell
        j = Len(c)
        'Find first delimiter and store position
        i = Application.WorksheetFunction.Search("-", c.Value)
        'Get strings!
        strSearch = Left(c, i - 1)
        strReplace = Right(c, j - i)
        'Find and Replace
        Range("c2:c121").Cells.Replace What:=strSearch, Replacement:=strReplace, LookAt:=xlWhole, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    End If
 Next c

Application.ScreenUpdating = True
End Sub