无法使用VBA提取模式

时间:2016-07-20 07:48:30

标签: excel vba excel-vba

我在一个单元格中有很多行,跨越一列。我想在之后提取评论和日期。每个日期都以 func tableView(tableView: UITableView, estimatedHeightForRowAtIndexPath indexPath: NSIndexPath) -> CGFloat { return 80 // customize the height } override func tableView(tableView: UITableView, heightForRowAtIndexPath indexPath: NSIndexPath) -> CGFloat { return UITableViewAutomaticDimension } 开头。例如。

?#+@

所以,我想在结果表中一起提取Hello ?#+@2013 12 31T06:27:58+0000Great post ?#+@2013 12 31T06:33:23+0000Awesome post Thanks?#+@2013 12 31T06:49:38+0000 hello等等。

我遇到了相同的VBA代码。但是,它没有提供任何输出。

代码如下:

2013 12 31T06:27:58+0000

任何帮助都将不胜感激。

3 个答案:

答案 0 :(得分:0)

以下代码有望实现您的目标:

Sub datascrub()

    On Error Resume Next
    Set SourceSheet = ActiveSheet
    Set TargetSheet = ActiveWorkbook.Sheets("Results")
    If Err = 0 Then
        Worksheets("Results").Delete
    End If

    Worksheets.Add
    ActiveSheet.Name = "Results"
    Set TargetSheet = ActiveSheet
    Cells(1, 1).Value = "Found Codes"
    Cells(1, 1).Font.Bold = True
    iTargetRow = 2

    SourceSheet.Select
    Selection.SpecialCells(xlCellTypeLastCell).Select
    Range(Selection, Cells(1)).Select

    For Each c In Selection.Cells
        sRaw = c.Value
        iPos = InStr(sRaw, "?#+@")
        Do While iPos > 0

            'Use the following line if you want message?#+@date in column A
            TargetSheet.Cells(iTargetRow, 1) = Left(sRaw, iPos + 27)

            'Or use the following two lines if you want the message in column A and the date in column B
            'TargetSheet.Cells(iTargetRow, 1) = Left(sRaw, iPos - 1)
            'TargetSheet.Cells(iTargetRow, 2) = Mid(sRaw, iPos + 4, 24)


            iTargetRow = iTargetRow + 1

            sRaw = Mid(sRaw, iPos + 28)
            iPos = InStr(sRaw, "?#+@")
        Loop
    Next c
End Sub

答案 1 :(得分:0)

问题在于Like:它与文字"?#+ @"不匹配,因为其中一些字符对Like具有特殊含义。

我建议:

  • 声明您的变量并将Option Explicit放在顶部以要求变量声明。这是一个好习惯,有助于消除明显的错误;
  • 不要将错误抑制超过必要的时间。只要您不再需要压制它们,请立即On Error Goto 0。这将再次帮助您更轻松地解决代码问题;
  • 使用Split抓取字符串的一部分;
  • 不使用Like:正如评论中所提到的,你需要转义几个字符,但更重要的是,因为你想要分解字符串,你可以通过Split
  • 将提取的时间戳转换为Excel日期/时间格式。

以下是建议的代码:

Option Explicit

Sub datascrub()
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim iTargetRow As Long
    Dim sDate As String
    Dim c As Range
    Dim line, pair

    Set SourceSheet = ActiveSheet
    On Error Resume Next
        Worksheets("Results").Delete
    On Error GoTo 0
    Worksheets.Add
    ActiveSheet.Name = "Results"
    Set TargetSheet = ActiveSheet
    Cells(1, 1).Value = "Found Codes"
    Cells(1, 1).Font.Bold = True
    iTargetRow = 2

    SourceSheet.Select
    Selection.SpecialCells(xlCellTypeLastCell).Select
    Range(Selection, Cells(1)).Select

    For Each c In Selection.Cells
        For Each line In Split(c.Value, "+0000")
            If line = "" Then Exit For
            pair = Split(line, "?#+@")
            sDate = Replace(Replace(pair(1), " ", "-"), "T", " ")
            TargetSheet.Cells(iTargetRow, 1) = pair(0)
            TargetSheet.Cells(iTargetRow, 2) = CDate(sDate)
            iTargetRow = iTargetRow + 1
        Next line
    Next c
End Sub

对于问题中的样本数据,它会产生:

| Found Codes         |                  |
| Hello               | 31/12/2013 06:27 |
| Great post          | 31/12/2013 06:33 |
| Awesome post Thanks | 31/12/2013 06:49 |

答案 2 :(得分:0)

我相信这就是你所追求的:

Option Explicit

Sub datascrub()
    Dim SourceSheet As Worksheet, TargetSheet As Worksheet
    Dim iArr As Long
    Dim cell As Range
    Dim tempArr As Variant

    Set TargetSheet = GetWorkSheet(ThisWorkbook, "Results") '<--| get/set "results" sheet
    With TargetSheet
        .Cells(1, 1).Value = "Found Codes"
        .Cells(1, 1).Font.Bold = True
    End With

    With ThisWorkbook.Worksheets("Source") '<--| explicitly reference "Source" sheet (change "Source" as per your actuale source sheet name)
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| consider only text values in column "A" (or change "A" as per your possible different needs)
            .Replace What:="+0000", Replacement:="+0000||", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True '<--| "mark" the wanted records by inserting "||" after each date end (I assume it always ends with "+0000")
            For Each cell In .Cells '<--| loop through considered cells
                tempArr = Split(cell.Value2, "||") '<--| fill the temporary array with the current cell content records
                For iArr = LBound(tempArr) To UBound(tempArr) - 1 '<--| loop through the temporary array..
                    TargetSheet.Cells(TargetSheet.Rows.Count, 1).End(xlUp).Offset(1) = Split(tempArr(iArr), "?#+@")(0) & " " & Split(tempArr(iArr), "?#+@")(1) '<--| ... and write results
                Next iArr
            Next cell
            .Replace What:="||", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True '<--| remove the "mark" we inserted at the beginning
        End With
    End With
End Sub

Function GetWorkSheet(wb As Workbook, shtName As String) As Worksheet
    On Error Resume Next
    Set GetWorkSheet = wb.Worksheets(shtName)
    If GetWorkSheet Is Nothing Then
        Set GetWorkSheet = wb.Worksheets.Add
        ActiveSheet.Name = shtName
    Else
        GetWorkSheet.Cells.ClearContents
    End If
End Function

根据您的需要更改参考文献(参见评论)

如果你需要在每个“date&amp; content”字符串之间加一些分隔符或者反转它们的序列或者将它们放在两个不同的单元格中,只需调整:

TargetSheet.Cells(TargetSheet.Rows.Count, 1).End(xlUp).Offset(1) = Split(tempArr(iArr), "?#+@")(0) & " " & Split(tempArr(iArr), "?#+@")(1)