Excel从字符串中获取多个子字符串

时间:2019-02-28 17:28:36

标签: excel vba

我在一个名为Comments(可通过Resources访问的工作表中的一个名为Resources[@Comments]的列的Excel文件中,数据看起来类似,

+=============================================+
| 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       |
+---------------------------------------------+

我正在寻找的输出应该类似于(基本上是在Chapter changed from < SOURCE > 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       |              |              |
+---------------------------------------------+--------------+--------------+

注意:

  • 单元格可能没有任何“更改章节”文本,在这种情况下,无需进行处理。

  • “章节更改”文本始终是最后一行。

  • 只想跟踪今天的更改(例如[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 :(得分:0)

实际上很简单...

  1. 使用vbnewlineChr(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

答案 1 :(得分:0)

您可以使用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