Vba 如何在搜索范围内搜索？

我有以下数据，我想将其映射到具有特定格式的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"  

类似地，我必须对所有节点执行此操作。我已经在这上面停留了一个多星期，只是似乎无法获得它，请帮助

这是我想要编辑的示例文本

另外，我已经在“A:A”中将此文本导入excel表格

这就是我使用宏所需要的输出类型

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次重复出现，如果我尝试扩展范围，它会阻塞

---

如果您将输出更改为单行表条目而不是双线“段落”，您的生活将变得简单得多。[如果需要，您可以在稍后的阶段重新格式化。]作为第一步，我将开发一个“解析器”“要将您的输入重新格式化（在相邻的工作表上）为单行条目。

您能否显示您已经完成的工作，即发布一些代码？我已经在上面发布了我的代码，您可以查看一下。您能否显示数据的屏幕截图？这一点：

我已经在“A:A”中将此文本导入excel工作表。

我想查看文件的结构/布局啊，我希望可以，但由于我的声誉不高，网站不允许我这样做！！。我会告诉你它是怎样的，我上面发布的数据，所有的数据都在A列，下一行在下一行，就是它。IE的第一行是A1，下一行是A2，空行是A3，等等。希望对你有所帮助你可以上传到一个免费的图片托管网站，并把图片的链接放在你的问题中。嗨，我对这个很陌生，你能指导我完成你的声明吗

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