求助解决从文本中返回特定的航班信息，复杂透了！

ggmmlol · 发表于 2023-6-8 02:09

行程提取2.rar (14.89 KB, 下载次数: 5)

1121228509 · 发表于 2023-6-8 22:28

Option Explicit

Sub 航班提取()
Dim dic As Object
Dim Arr As Variant
Dim fk As Long, xh As Long, h As Long, js As Long, s As Long, z As Long, yy As Long, y As Long
fk = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
Sheets("Sheet1").Range("B2").Resize(fk, 1).Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 'Range("Z27:Z29")去除空格
Sheets("Sheet1").Range("B2").Resize(fk, 1).Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 'Range("Z27:Z29")删除记忆自动换行符
Arr = Sheets("Sheet1").Range("A2").Resize(fk, 2)
For xh = 1 To fk
js = js + Len(Arr(xh, 2)) - Len(Replace(Arr(xh, 2), "[", ""))
Next xh
ReDim Brr(1 To js, 1 To 2) As Variant
For xh = 1 To fk
js = Len(Arr(xh, 2)) - Len(Replace(Arr(xh, 2), "[", ""))
h = Len(Arr(xh, 2)) - Len(Replace(Arr(xh, 2), "]", ""))
If js > 0 And h > 0 Then
      For h = 1 To js
         z = InStr(Arr(xh, 2), "[") + 1
         yy = InStr(Arr(xh, 2), "]")
         y = yy - z
         s = s + 1
         Brr(s, 1) = s
         Brr(s, 2) = Format$(Arr(xh, 1), "m月d日") & "：" & Mid(Arr(xh, 2), z, y)
         Arr(xh, 2) = Mid(Arr(xh, 2), yy + 1, 9999)
      Next h
End If
Next xh
Sheets("Sheet1").Range("E2").Resize(s, 2) = Brr
End Sub

行程提取1.rar (19.11 KB, 下载次数: 0)

		自动登录	找回密码
密码			免费注册

[已解决] 求助解决从文本中返回特定的航班信息，复杂透了！