我有以下数据，我想将其映射到具有特定格式的Excel工作表。我需要提取节点名称，即。"BLRTRC1"，"BSC23"，"BSC41"（可能会出现多个具有不同警报条件的单个节点）。
首先我必须搜索"BLRTRC1"，现在我想在其范围内搜索所有可能存在的警报名称，例如“同步数字路径故障监控”，“数字路径质量监控”等。直到下一个节点名称没有显示（就像在这种情况下"BSC23"在"BLRTRC1"出现3次后出现
然后使用警报名称和警报统计信息（如
）打印节点名称"SDIP STATE LAYER K L M FAULT INFO DATE TIME
8ETM2 TRAFLIM VC15-2 32 1 1 UNEQ 130226 030244"
同样，我必须为所有节点执行此操作。我已经坚持了一个多星期了，似乎无法得到它，请帮忙。
以下是我要编辑的示例文字。
PS。我已将此文本导入到“A：A”
中的Excel工作表中A1/APT "BLRTRC1\02\G12" 007 130226 0302
SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION
SDIP STATE LAYER K L M FAULT INFO DATE TIME
8ETM2 TRAFLIM VC15-2 32 1 1 UNEQ 130226 030244
TYPE PL/TTI ERDIINFO
A1/APT "BLRTRC1\02\G12" 007 130226 0302
SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION
SDIP STATE LAYER K L M FAULT INFO DATE TIME
7ETM2 TRAFLIM VC12-2 3 1 1 UNEQ 130226 030244
TYPE PL/TTI ERDIINFO
A3/APT "BLRTRC1\02\G12" 009 130226 0302
DIGITAL PATH QUALITY SUPERVISION
SDIP STATE LAYER K L M FAULT INFO DATE TIME
7ETM2 TRAFLIM VC12-8 3 3 1 UNEQ 130226 030244
TYPE PL/TTI ERDIINFO
A3/APT "BBSC23/G12A/CPA" 021 130521 1130
DIGITAL PATH QUALITY SUPERVISION
SES
DIP DIPPART SESL2 QSV SECTION DATE TIME
42MNPBS 1 1 130521 113000
TYPE PL/TTI ERDIINFO
A2/APT "BSC41\\CPA02\\G" 985 130521 1204
DIGITAL PATH FAULT SUPERVISION
DIP DIPEND FAULT SECTION HG DATE TIME
BL2397 RDI 130521 120407
这是我使用宏
所需的输出类型nodename Alarm name alarmlevel
BLRTRC1 SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION SDIP STATE LAYER K L M FAULT INFO DATE TIME
8ETM2 TRAFLIM VC15-2 32 1 1 UNEQ 130226 030244
BLRTRC1 SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION SDIP STATE LAYER K L M FAULT INFO DATE TIME
7ETM2 TRAFLIM VC12-2 3 1 1 UNEQ 130226 030244
BLRTRC1 DIGITAL PATH QUALITY SUPERVISION SDIP STATE LAYER K L M FAULT INFO DATE TIME
7ETM2 TRAFLIM VC12-8 3 3 1 UNEQ 130226 030244
BSC23 DIGITAL PATH QUALITY SUPERVISION DIP DIPPART SESL2 QSV SECTION DATE TIME
42MNPBS 1 1 130521 113000
BSC41 DIGITAL PATH FAULT SUPERVISION DIP DIPEND FAULT SECTION HG DATE TIME
BL2397 RDI 130521 120407
这是我到目前为止所使用的代码
Sub Search11()
Dim TEST
Dim Today
Today = Now
Dim c(4) As Variant
Dim a(4) As Variant
a(0) = 1
For i = 0 To 3
Set Test20 = Range(Cells(a(i), 1), Cells(a(i) + 32, 1)).Find(What:="BLRTRC1")
If Test20 Is Nothing Then
GoTo LABEL1
Else
a(i + 1) = Test20.Row
c(i) = "BLRTRC1"
End If
LABEL1: Next i
Dim d(4) As Variant
Dim b(4) As Variant
b(0) = 1
For i = 0 To 3
Set Test21 = Range(Cells(b(i), 1), Cells(b(i) + 32, 1)).Find(What:="BSC23")
If Test21 Is Nothing Then
GoTo LABEL2
Else
b(i + 1) = Test21.Row
d(i) = "BSC23"
End If
LABEL2: Next i
Dim e(4) As Variant
Dim f(4) As Variant
e(0) = 1
For i = 0 To 3
Set Test21 = Range(Cells(e(i), 1), Cells(e(i) + 32, 1)).Find(What:="BSC41")
If Test21 Is Nothing Then
GoTo LABEL3
Else
e(i + 1) = Test21.Row
f(i) = "BSC41"
End If
LABEL3: Next i
Dim o(3) As Variant
o(0) = "SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION"
o(1) = "DIGITAL PATH QUALITY SUPERVISION"
o(2) = "DIGITAL PATH FAULT SUPERVISION"
Dim t(2) As Variant
t(0) = "SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION/A1"
t(1) = "DIGITAL PATH QUALITY SUPERVISION/A3"
t(2) = "DIGITAL PATH FAULT SUPERVISION/A2"
Dim s(3) As Variant
s(0) = "SDIP"
s(1) = "DIP"
s(2) = "DIP"
R = 2
i = 0
For i = 0 To 3
k = 0
If a(i) > 0 Then
For k = 0 To 2
Set Test4 = Range(Cells(a(i), 1), Cells(a(i) + 10, 1)).Find(What:=o(k))
If Test4 Is Nothing Then
GoTo NXTALARM
Else
Set Test5 = Range(Cells(a(i), 1), Cells(a(i) + 10, 1)).Find(What:=s(k))
If Test5 Is Nothing Then
GoTo NXTALARM
Else
p = Test5.Row
Cells(p + 1, 1).Select
Selection.Copy
Sheets("Sheet2").Activate
Range("C" & R + 1).Select
ActiveSheet.Paste
Cells(R, 1).Value = c(i)
Cells(R, 2).Value = t(k)
Cells(R, 3).Value = Test5
Cells(R, 4).Value = Today
Sheets("Sheet4").Activate
R = R + 2
End If
End If
NXTALARM: Next k
Else
End If
If b(i) > 0 Then
For k = 0 To 2
Set Test4 = Range(Cells(b(i), 1), Cells(b(i) + 10, 1)).Find(What:=o(k))
If Test4 Is Nothing Then
GoTo NXTALARM2
Else
Set Test5 = Range(Cells(b(i), 1), Cells(b(i) + 10, 1)).Find(What:=s(k))
If Test5 Is Nothing Then
GoTo NXTALARM2
Else
p = Test5.Row
Cells(p + 1, 1).Select
Selection.Copy
Sheets("Sheet2").Activate
Range("C" & R + 1).Select
ActiveSheet.Paste
Cells(R, 1).Value = d(i)
Cells(R, 2).Value = t(k)
Cells(R, 3).Value = Test5
Cells(R, 4).Value = Today
Sheets("Sheet4").Activate
R = R + 2
End If
End If
NXTALARM2: Next k
Else
End If
If e(i) > 0 Then
For k = 0 To 2
Set Test4 = Range(Cells(e(i), 1), Cells(e(i) + 10, 1)).Find(What:=o(k))
If Test4 Is Nothing Then
GoTo NXTALARM2
Else
Set Test5 = Range(Cells(e(i), 1), Cells(e(i) + 10, 1)).Find(What:=s(k))
If Test5 Is Nothing Then
GoTo NXTALARM3
Else
p = Test5.Row
Cells(p + 1, 1).Select
Selection.Copy
Sheets("Sheet2").Activate
Range("C" & R + 1).Select
ActiveSheet.Paste
Cells(R, 1).Value = f(i)
Cells(R, 2).Value = t(k)
Cells(R, 3).Value = Test5
Cells(R, 4).Value = Today
Sheets("Sheet4").Activate
R = R + 2
End If
End If
NXTALARM3: Next k
Else
End If
'NXTALARM: Next k
NXTNODE: Next i
'Application.Run ("multiplebuttons")
'Application.Run ("CommentAddOrEdit")
' MsgBox a(55)
End Sub
我的这段代码导致100次重复发生，如果我尝试扩展它的范围，它会卡住!!
答案 0 :(得分：-1)
如果将输出更改为单行表条目而不是双行“段落”，则可以简化生活。 [如果需要，您可以在稍后阶段重新格式化。]作为第一步，我将开发一个“解析器”，将您的输入重新格式化到相邻的工作表上，形成单行条目。