怎么样把每类信息逐一删选出来

第一个表里的信息是在一个单元格里还是分为几个格子，由于图上的格子太小，不明你的信息是放在哪几个格子里。

把两表格发一个给我，我帮你写一个脚本

写了个代码，应该可以用，亲测有效：
Option Explicit
Sub 提取站名时间()
Dim everycell, wokcell, zhanm As Range, n, i As Integer, panduan As Boolean
Dim shijianhang As Boolean
Dim dizhihang As Boolean
Dim kongbaihang As Boolean
Dim response As String
response = InputBox("请将你的源文件置于第一个工作表，并准备好第二个空白的工作表，准备好了的话，请输入OK")
Select Case response
Case "OK"
GoTo continue
Case Else
End
End Select
continue: Set wokcell = Application.Intersect(Sheets(1).UsedRange, Sheets(1).Columns(1))
n = wokcell.Rows.Count
Sheets(2).Cells(1, 1) = "时间"
For i = 1 To n
Set zhanm = Sheets(1).Cells(i + 1, 1)
shijianhang = zhanm Like "20*"
dizhihang = (zhanm Like "我在*") Or (zhanm Like "*你*")
kongbaihang = zhanm = ""
panduan = (Not shijianhang) And (Not dizhihang) And (Not kongbaihang)
If panduan = True Then
Sheets(2).Cells(i + 1, 1) = Left(Sheets(1).Cells(i, 1), 19)
End If
Next i
Dim j As Integer
Do While Application.CountIf(Sheets(2).UsedRange, "") > 0
For j = 1 To Sheets(2).UsedRange.Rows.Count
If Sheets(2).Cells(j, 1) = "" Then
Sheets(2).Cells(j, 1).Delete
End If
Next j
Loop
Sheets(2).Columns(1).HorizontalAlignment = xlHAlignCenter
MsgBox ("所有站名的时间已全部提取完毕！共获取了" & Sheets(2).UsedRange.Rows.Count - 1 & "条时间记录")
End Sub

进一步优化版：
Option Explicit
Sub 提取站名时间()
Dim everycell, wokcell, zhanm As Range, n, i As Integer, panduan As Boolean
Dim shijianhang As Boolean
Dim dizhihang As Boolean
Dim kongbaihang As Boolean
Dim response As String
response = InputBox("请将你的源文件置于第一个工作表，并准备好第二个空白的工作表，准备好了的话，请输入OK")
Select Case response
Case "OK"
GoTo continue
Case Else
End
End Select
continue: Set wokcell = Application.Intersect(Sheets(1).UsedRange, Sheets(1).Columns(1))
n = wokcell.Rows.Count
Sheets(2).Cells(1, 1) = "时间"
Sheets(2).Cells(1, 2) = "站名摘要"
For i = 1 To n
Set zhanm = Sheets(1).Cells(i + 1, 1)
shijianhang = zhanm Like "20*"
dizhihang = (zhanm Like "我在*") Or (zhanm Like "*你*") Or (Not (VBA.IsNumeric(Mid(zhanm, 6, 1))))
kongbaihang = zhanm = ""
panduan = (Not shijianhang) And (Not dizhihang) And (Not kongbaihang)
If panduan = True Then
Sheets(2).Cells(i + 1, 1) = Left(Sheets(1).Cells(i, 1), 19)
Sheets(2).Cells(i + 1, 2) = Sheets(1).Cells(i + 1, 1)
End If
Next i
Dim j As Integer
Do While Application.CountIf(Sheets(2).UsedRange, "") > 0
For j = 1 To Sheets(2).UsedRange.Rows.Count
If Sheets(2).Cells(j, 1) = "" Then
Sheets(2).Cells(j, 1).Delete
Sheets(2).Cells(j, 2).Delete
End If
Next j
Loop
Sheets(2).Columns(1).HorizontalAlignment = xlHAlignCenter
Sheets(2).Columns(2).ColumnWidth = 50
Sheets(2).Columns(1).ColumnWidth = 25
MsgBox ("所有站名的时间已全部提取完毕！共获取了" & Sheets(2).UsedRange.Rows.Count - 1 & "条时间记录")
End Sub
主要增加了对闲杂聊天记录的过滤，并植入了站名摘要，方便检查。
使用有问题再找我 ，进一步修改