Excel получает несколько подстрок из строки - PullRequest
0 голосов
/ 28 февраля 2019

У меня есть файл Excel со столбцом с именем Comments на листе с именем Resources (доступный как Resources[@Comments]), данные выглядят примерно так:

+=============================================+
| Comments                                    |
+=============================================+
| [7/2] Level changed from 10 to 9            |
| [14/2] Alignment changed from ABC to XYZ    |
| [21/2] Location changed from US to UK       |
| [28/2] Chapter changed from [blank] to ABCD |
+---------------------------------------------+
| [14/2] Level changed from 5 to 4            |
| [21/2] Location changed from US to UK       |
| [21/2] Chapter changed from JKLM to ABCD    |
+---------------------------------------------+
| [28/2] Chapter changed from EFGH to MNOP    |
+---------------------------------------------+
| [21/2] Location changed from IN to JP       |
+---------------------------------------------+

Вывод Iищу должен выглядеть примерно так (по сути извлечение текста между Chapter changed from < ИСТОЧНИК > to < DESTINATION >),

+=============================================+==============+==============+
| Comments                                    | Old Chapter  | New Chapter  |
+=============================================+==============+==============+
| [7/2] Level changed from 10 to 9            | [blank]      | ABCD         |
| [14/2] Alignment changed from ABC to XYZ    |              |              |
| [21/2] Location changed from US to UK       |              |              |
| [28/2] Chapter changed from [blank] to ABCD |              |              |
+---------------------------------------------+--------------+--------------+
| [14/2] Level changed from 5 to 4            |              |              |
| [21/2] Location changed from US to UK       |              |              |
| [21/2] Chapter changed from JKLM to ABCD    |              |              |
+---------------------------------------------+--------------+--------------+
| [28/2] Chapter changed from EFGH to MNOP    | EFGH         | MNOP         |
+---------------------------------------------+--------------+--------------+
| [21/2] Location changed from IN to JP       |              |              |
+---------------------------------------------+--------------+--------------+

Примечания:

  • В ячейке может отсутствовать текст «Глава изменена», в этом случае обработка не требуется.

  • Текст «Глава изменена» всегда последнийline.

  • Отслеживать изменение нужно только в том случае, если оно было сегодня (например, [28/2] =TEXT(today(), "dd/m")

  • Я думаю, Excelпереносит текст в "" (двойные кавычки).

Я доволен либо формулой Excel, либо сценарием VBA.Уже пробовал такие вещи, как KuTools, =MID(Resources[@Comments],SEARCH("Chapter changed from",Resources[@Comments])+20,SEARCH("to", Resources[@Comments]) - SEARCH("Chapter changed from",Resources[@Comments])-21).

Чтобы проверить часть даты, которую я использую, =IF(ISNUMBER(SEARCH("["&TEXT(TODAY(), "dd/m")&"] Chapter changed", Resources[@Comments])), "Yes", "")

Спасибо.

Ответы [ 2 ]

0 голосов
/ 01 марта 2019

Вы можете использовать Replace() метод Range объекта:

Sub DoThat()
    Dim cell As Range
    With Range("A1", Cells(Rows.Count, 1).End(xlUp))
        .Offset(, 1).Resize(, 2).Value = .Value
        For Each cell In .Offset(, 1).Cells
            If InStr(cell.Value2, Format(Date, "D/M")) > 0 Then
                cell.Replace "*from ", ""
                cell.Replace " to *", ""                
                cell.Offset(, 1).Replace "*to ", ""
            Else
                cell.Resize(, 2).ClearContents
            End If
        Next
    End With
End Sub
0 голосов
/ 28 февраля 2019

На самом деле это довольно просто ...

  1. Пролить содержимое ячейки с помощью vbnewline или Chr(10)
  2. Разделить на "["
  3. Разделитьна «]»
  4. Дата проверки
  5. Разделить на «от»
  6. Разделить на «на»

Код : Это то, что вы пытаетесь?

Sub Sample()
    Dim cellValue As String
    Dim tmpAr As Variant
    Dim Dt As String, lastLine As String
    Dim OLDc  As String, NEWc As String
    Dim rng As Range

    '~~> Set the range
    Set rng = Sheet1.Range("A2")

    '~~> Split on Linefeed. It could be Chr(13) as well
    tmpAr = Split(rng.Value, Chr(10))

    '~~> Get the last line
    lastLine = tmpAr(UBound(tmpAr))

    '~~> Get the date part
    Dt = Split(lastLine, "[")(1)
    Dt = Split(Dt, "]")(0)

    '~~> Check if it is same as today
    If Format(Date, "D/M") = Dt Then
        lastLine = Split(lastLine, "from")(1)
        OLDc = Trim(Split(lastLine, "to")(0))
        NEWc = Trim(Split(lastLine, "to")(1))

        rng.Offset(, 1).Value = OLDc
        rng.Offset(, 2).Value = NEWc
    End If
End Sub

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...