Удалите текст (влево или вправо) с помощью VBA, чтобы я оставил только определенную строку - PullRequest
Новая
       43

Удалите текст (влево или вправо) с помощью VBA, чтобы я оставил только определенную строку

2 голосов
/ 13 мая 2019

Каждый день мы получаем файл Excel, который содержит дамп базы данных. Большая часть файла сортируется в скрипте VBA, который я создал, но у меня осталась одна проблема, которую я не могу решить. В одном из столбцов (A) у меня иногда есть 2 строки, мне нравится оставлять только одну из них. Строка, которую я хотел бы сохранить, выглядит как "M1234 5678". Цифры меняются ... Иногда в столбце есть другой текст до или после M1234 5678. Я хотел бы удалить весь этот текст, чтобы сохранить только необходимую строку.

Я уже пытался использовать функцию поиска, пытаясь решить проблему с помощью функции обрезки и поиска строки, которая выглядела как "M #### ####". Не повезло идти по этой дороге. Я должен признать, что это было 2 недели назад, когда я шутил с кодом ниже, что он может быть испорчен из-за того, что я пытался решить в тот момент. 

    Sub TrimText()
       Dim FinalValue As String
       Dim lastStop As Long
       With Sheets("Blad2")
       lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
       For i = 2 To lastStop
       FinalValue = Trim(Cells(i, 1).Value)
       If InStr(FinalValue, "ALQ") > 0 Then
       Cells(i, 1).Value = Left(FinalValue, InStr(FinalValue, "M*"))
       End If
       Next
       End With
    End Sub

Я надеюсь удалить любой текст слева или справа от строки M #### ####.

Спасибо за помощь.

Ответы [ 2 ]

2 голосов
/ 13 мая 2019

Вы можете использовать шаблон регулярного выражения, если длина строки остается постоянной 

M\d{4}\s\d{4}

Это может выглядеть как вызов функции (если условие удалено) 

Option Explicit
Public Sub TrimText()
    Dim FinalValue As String, lastStop As Long, i As Long, re As Object
    Set re = CreateObject("VBScript.RegExp")
    With ThisWorkbook.Worksheets("Blad2")
        lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastStop
            FinalValue = Trim(Cells(i, 1).Value)
            .Cells(i, 1).Value = ReplaceMatch(re, .Cells(i, 1).Value, "M\d{4}\s\d{4}")
        Next
    End With
End Sub

Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .MultiLine = True
        .pattern = pattern

        If .test(inputString) Then
            ReplaceMatch = .Execute(inputString)(0)
        Else
            ReplaceMatch = inputString
        End If
    End With
End Function
0 голосов
/ 13 мая 2019

Я получил его на работу следующим образом: 

    Option Explicit
    Public Sub TrimText()
        Dim FinalValue As String, lastStop As Long, i As Long, re As Object
        Set re = CreateObject("VBScript.RegExp")
            lastStop = Cells(Rows.Count, "A").End(xlUp).Row
            For i = 2 To lastStop
                FinalValue = Trim(Cells(i, 1).Value)
                Cells(i, 1).Value = ReplaceMatch(re, Cells(i, 1).Value, "M\d{4}\s\d{4}")
            Next
    End Sub

    Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
        With re
            .Global = True
            .MultiLine = True
            .pattern = pattern

            If .test(inputString) Then
                ReplaceMatch = .Execute(inputString)(0)
            Else
                ReplaceMatch = inputString
            End If
        End With
    End Function

Большое спасибо за помощь.

...