0
我有以下數據，我想將它映射到具有特定格式的Excel表中。我需要提取節點名稱即。 "BLRTRC1","BSC23","BSC41"（可能出現多個具有不同警報條件的單個節點）。如何在搜索範圍內搜索？
首先，我必須搜索"BLRTRC1"，現在我想搜索所有可以在其範圍內的警報名稱，例如「同步數字路徑故障監控」，「數字路徑質量監控」等。直到下一個節點名不露面
（如在這種情況下"BSC23"後出現3次的"BLRTRC1"顯示出來）然後打印帶有報警名稱節點名稱和報警統計資料，例如
"SDIP STATE LAYER K L M FAULT INFO DATE TIME
8ETM2 TRAFLIM VC15-2 32 1 1 UNEQ 130226 030244"
同樣我必須爲所有節點執行此操作。我已經堅持了一個多星期了，只是似乎無法得到它，請幫助。
這是我要編輯的示例文本。
PS。我已經導入這個文本到Excel工作表中的「A：A」
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
這個代碼是導致100s的重複發生，如果我試圖擴大範圍它stucks！
http://postimg.org/gallery/oqk3ga8/
你可以展示你已經完成的工作，即發佈一些代碼 – booyaa
我已經發布了我的代碼上面，你可以看看它。 – user2431436
你可以顯示你的數據的屏幕截圖嗎？這位：'我已經將這個文本導入到「A：A」的Excel表格中了''我想查看文件的結構/佈局 – 2013-05-29 09:09:23