在单元格中搜索全文一小时，并将该小时复制到VBA中的其他单元格

我有一个包含1200行的数据库，我想在一个满是笔记的单元格中搜索一个小时，然后将特定的小时复制到另一个单元格中

例如，在单元格中，我有如下数据： "我在车站等车,等6点45分,车还没停"

我得到的是：

Sub Find()
irow = 2
    Do Until IsEmpty(Cells(irow, 34))
        If Cells(irow, 34).Value Like "*[0-23]:[0-59]*" = True Then
            Cells(irow, 34).Value = Cells(irow, 37).Value
            irow = irow + 1
        Else
            irow = irow + 1
        End If
    Loop
End Sub

---

谢谢

以下代码在文本中查找时间戳，并将其写入同一行的单独列中。但是，它假定只存在一个“[数字][数字]：[数字][数字]”序列。如果您的输入可以有多个，您可能需要一些额外的筛选条件

但首先需要确保在VBA项目中激活了正则表达式。（见附件）

我使用以下行测试代码：

I wait to the bus in the bus a92ohr2902 stop for the ride of 6:58 and the ride did'nt stop
I wait to the bus in the bus ;3;23576;80-934 stop for the ride of 6:59 and the ride did'nt stop
I wait to the bus in the bus 2016-06-01 stop for the ride of 14:00 and the ride did'nt stop
I wait to the bus in the bus 9023845 stop for the ride of 14:01 and the ride did'nt stop
I wait to the bus in the bus ;3;23576;80-934 stop for the ride of 20:50 and the ride did'nt stop
I wait to the bus in the bus 2016-06-01 stop for the ride of 20:59 and the ride did'nt stop
I wait to the bus in the bus 9023845 stop for the ride of 21:00 and the ride did'nt stop
I wait to the bus in the bus a92ohr2902 stop for the ride of 21:01 and the ride did'nt stop

而不是

If Cells(irow, 34).Value Like "*[0-23]:[0-59]*" = True Then

试一试

您还可以使用以下代码：

Sub Find()
    Dim i As Integer
    Dim arr() As String

    irow = 2
    Do Until IsEmpty(Cells(irow, 34))
        arr = Split(Cells(irow, 34), " ")
        For i = LBound(arr) To UBound(arr)
            If IsTime(arr(i)) Then
                'to get the hour
                MsgBox Left(arr(i), Application.WorksheetFunction.Find(":", arr(i)) - 1)
                Cells(irow, 34).Value = Cells(irow, 37).Value
                Exit For
            End If
        Next
        irow = irow + 1
    Loop
End Sub

Function IsTime(strData As String) As Boolean
    On Error Resume Next
    IsTime = TimeValue(strData)
End Function

---

看起来不错，但如果我有其他号码的话？这样：“我在公共汽车站等254路公共汽车，乘6:57的车，但车没有停”@user3306637 True，在这种情况下，提供的代码似乎能更好地将时间戳与其他数字分开。Mrig的代码不起作用。您的代码工作得很好，只需检查此问题。@user3306637由于正则表达式对您可用，我简化了代码。现在不再需要提取时间戳。

If Cells(irow, 34).Value Like "*#:##*" Then

Sub Find()
    Dim i As Integer
    Dim arr() As String

    irow = 2
    Do Until IsEmpty(Cells(irow, 34))
        arr = Split(Cells(irow, 34), " ")
        For i = LBound(arr) To UBound(arr)
            If IsTime(arr(i)) Then
                'to get the hour
                MsgBox Left(arr(i), Application.WorksheetFunction.Find(":", arr(i)) - 1)
                Cells(irow, 34).Value = Cells(irow, 37).Value
                Exit For
            End If
        Next
        irow = irow + 1
    Loop
End Sub

Function IsTime(strData As String) As Boolean
    On Error Resume Next
    IsTime = TimeValue(strData)
End Function