Как я могу выполнить поиск и замену регулярных выражений в макросе VBA Excel?

Question

Я хотел бы создать макрос VBA, который заменяет все ячейки на листе текстовыми строками в формате времени (регулярное выражение):

(1[0-2]|[1-9]):[0-5][0-9]:[0-5][0-9] [AP]M

с адресом ячейки и именем листа.Я думаю, что вызов тоже будет похож:

 Cells.Replace What:="1:23:45 AM",    
    Replacement:="=cell(""filename"")&cell(""Address"")", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
    False, ReplaceFormat:=False

Но я надеюсь, что смогу сделать аргумент "What:=" обычным или хотя бы ограниченным форматом времени.

Как мне поступить?

---

Тестовые данные: Сохраните следующее в формате CSV:

00:00,04:27,00:36,04:31,00:00
00:00,00:00,04:18,01:07,10:06
00:00,00:00,00:00,00:00,00:00

В конце концов макросудалит все нулевые значения и заменит остальные времена статическим текстом, который является оценочной формулой =cell("filename")&"!"&cell("address")

---

Результат действия с вышеуказанным входным файлом (я буду сохранять листы как XLSX):

     [    A    ]   [     B     ]  [     C     ]  [     D     ]  [     E     ]
[1]                'Sheet1!$B$1   'Sheet1!$C$1   'Sheet1!$D$1
[2]                               'Sheet1!$C$2   'Sheet1!$D$2   'Sheet1!$E$2
[3]

Для краткости я вычеркнул каталог и имя файла, которые возвращает функция =cell("filename") , хотя вышесказанное мне действительно нужно.

Answer 1

Я обновил свой ранее размещенный код здесь до

1. Удалите все текстовые поля в выбранном пользователем диапазоне, которые '00:00
2. Замените всетекст "поля времени" с полным путем

(примечание: в конце Regex перебивает, так как тест ячейки для значения между 0,0 и 1,0 будет достаточным, учитывая фактический формат данных)

    'Press Alt + F11 to open the Visual Basic Editor (VBE)
    'From the Menu, choose Insert-Module.
    'Paste the code into the right-hand code window.
    'Press Alt + F11 to close the VBE
    'In Xl2003 Goto Tools … Macro … Macros and double-click KillTime  


    Sub KillTime()
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim strSht As String
    Dim X()

    On Error Resume Next
    Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    If rng1 Is Nothing Then Exit Sub
    On Error GoTo 0

    strSht = ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & rng1.Parent.Name
    'remove '00:00
    rng1.Replace "00:00", vbNullString, xlWhole

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "^0\.\d+$"    
     'Speed up the code by turning off screenupdating and setting calculation to manual
      'Disable any code events that may occur when writing to cells
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Test each area in the user selected range

    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngArea.Cells.Count > 1 Then
           'If there is more than once cell then set the variant array to the dimensions of the range area
           'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                   If objReg.test(X(lngRow, lngCol)) Then X(lngRow, lngCol) = strSht & rngArea.Cells(1).Offset(lngRow - 1, lngCol - 1).Address(0, 0)
                Next lngCol
            Next lngRow
            'Dump the updated array back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
               If objReg.test(rngArea.Value) Then rngArea.Value = strSht & rngArea.Address(0, 0)            
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
    End Sub

Answer 2

Поскольку вы пытаетесь заменить формат, я сделаю замену на основе формата.С регулярным выражением кажется, что вы будете вынуждены иметь дело с основным числом.

Я проверял это в XL 2003 и 2010:

Sub ReplaceByFormat()
With ActiveSheet.Cells
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
End With
End Sub

РЕДАКТИРОВАТЬ

Во-первых, во время размещения FindFormat в конце я ошибся.Это должно быть в начале (Doh).

Нет аргумента OR для функции замены.Итак, ниже, я только что повторил код для второго типа формата.

Этот код предполагает, что все даты являются константами.Если они являются формулами, вы можете исправить с помощью поиска и замены в VBA.Если это микс, вам нужно немного расширить код:

Sub ReplaceByFormat()

With ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "m/d/yyyy"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub

Answer 3

Во-первых, лучшая модель была бы:

  /[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M/

Во-вторых, реальный код без каких-либо специфических для вашей проблемы задач так же прост (как адаптация к вашему сценарию, конечно):

Set RegExp= CreateObject("VBScript.RegExp")
RegExp.Pattern = "[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M"
For i = ......
  Expr = Format(ActiveSheet.Cells(i, 1).Value, ActiveSheet.Cells(i, 1).NumberFormat)
  If RegExp.Test(Expr) Then Replace....
Next i

Таким образом VBA будет обрабатывать значения в ячейках по мере их появления.

EDIT

О шаблоне, также совпадающем с "29:00:00 | M" - я не знаю, почему "|" считается действительным символом, поскольку означает «ИЛИ». То же самое происходит, если вы используете ",". Во всяком случае, лучше, конечно, это:

/^(([0-1]?[0-9])|(2[0-4])):[0-5][0-9]:[0-5][0-9] [A|P]M$/

• Позволяет только 0-24 часа
• «^» и «$» гарантируют, что в ячейке содержится только значение формата времени, обозначающее начало и конец строки

Но, в конце концов, не имеет значения, соответствует ли шаблон RegExp ТОЧНО только временным значениям, потому что форматирование входных данных будет выполнено в Excel, который предварительно проверит содержимое ячейки (если вы введете «29»). : 00: 00 "он преобразует его в 5 часов утра следующего дня). Это решение Excel может привести только к решению Excel, но не к глобальному решению.

В этом смысле использование регулярных выражений даже не распространено в Excel - RegExp является тестером строк без оценки семантического значения, для которой у вас есть другие средства для проверки входных данных в этом контексте. Например, вы можете сделать то же самое с чистым VBA:

Function IsTime(rng As Range) As Boolean
  Dim sValue As String
  sValue = rng.Cells(1).Text
  On Error Resume Next
  IsTime = IsDate(TimeValue(sValue))
  On Error GoTo 0
End Function
'Source: http://excel.tips.net/T003292_Checking_for_Time_Input.html