Excel VBA尝试将数组与通配符匹配

时间:2018-09-12 13:31:00

标签: excel excel-vba match wildcard rtf

我目前有一段过去的代码...

Dim ArrNames

ArrNames = Array("X-Axis", "Y-Axis", "Z-Axis", "Flatness", _
  "Length-X", "Length-Y", "Length-Z", "Length_X", "Length_Y", _
  "Length_Z", "Length", "Angle", "Angle-XY", "Angle-XZ", "Angle-YX", _
  "Angle-YZ", "Angle-ZX", "Angle-ZY", "Radius", "Diameter", "Flatness", _
  "Straightness", "Parallelism", "Perpendicular", "Circularity")

Sheets(2).Range("A:A").Copy Destination:=Sheets(1).Range("A:A", "C:C")

With ActiveSheet
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    For Lrow = Lastrow To 1 Step -1
        With .Cells(Lrow, "C")
            If IsError(Application.Match(.Value, ArrNames, 0)) Then .ClearContents
        End With
    Next Lrow
    For Lrow = Lastrow To 1 Step -1
        With .Cells(Lrow, "A")
            If Not IsError(Application.Match(.Value, ArrNames, 0)) Then .ClearContents
        End With
    Next Lrow
End With

所以这是...它从工作表#2复制一列(列A),并将内容粘贴到工作表#1的两个位置(列A和列C)。数据包含几百行这样的字符串:

(Z): Item (126) / (X) : Item (132)
Circle:P4_EJECTOR_SIDE_OP_10_Locate
Z-axis
X-axis

Point:P8_PAD_PNT
Y-axis

Plane:P8_PAD
Flatness
Parallelism

Circle:P8_EJECTOR_SIDE_DEEP
Z-axis
X-axis

然后,我逐行遍历工作表#1的C列,以检查单元格内容是否与数组中的任何值匹配。如果找不到匹配项,则清除单元格中的内容。

然后,类似地,我逐行遍历工作表#1列A,以检查单元格内容是否与数组中的任何值匹配。但是,在这种情况下,如果找到匹配项,我将清除单元格的内容(因此基本上与C列的工作相反)。

这只是大型动物的一部分,该动物会自动导入单独的.csv文件并将其汇总在一起进行统计分析,并且可以正常工作。

现在,我正在尝试对.rtf文件执行类似的操作。文件看起来像这样...

(Z): Item (126) / (X) : Item (132)
Circle:P4_EJECTOR_SIDE_OP_10_Locate
Z-axis       -46.435   -46.500    -0.150    +0.150     0.065 ---+*--
X-axis      -116.836  -117.000    -0.150    +0.150     0.164 ---+-->       0.014
--------------------------------------------------------------------------------
Point:P8_PAD_PNT
Y-axis       -21.611   -21.500    -0.200    +0.200    -0.111 -*-+---
--------------------------------------------------------------------------------
Plane:P8_PAD
Flatness       0.015     0.200                                  *---
Parallelism    0.078     0.200,FA(Part_Offset_Plane)            +*--
--------------------------------------------------------------------------------
Circle:P8_EJECTOR_SIDE_DEEP
Z-axis         0.072     0.000    -0.150    +0.150     0.072 ---+*--
X-axis        -0.010     0.000    -0.150    +0.150    -0.010 ---*---

因此,我试图修改ArrNames以包含通配符,如下所示:

ArrNames = Array(“ --- *”)

但是它不起作用...

我正在尝试删除所有的“ ---------------------”

这是我的确切代码:

子测试()

Dim Word As New Word.Application
Dim WordDoc As New Word.Document
Dim FilesToOpen
Dim x As Integer
Dim Lrow As Long
Dim Lastrow As Long
Dim ArrNames

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

ArrNames = Array("---*")

FilesToOpen = Application.GetOpenFilename _
  (FileFilter:="RTF Files (*.rtf), *.rtf", _
  MultiSelect:=True, Title:="Files to Open")

Application.DisplayAlerts = False

x = 1

Set WordDoc = Word.Documents.Open(Filename:=FilesToOpen(x), ReadOnly:=True)
Word.Selection.WholeStory
Word.Selection.Copy

Range("A1").Select
ActiveSheet.Paste

WordDoc.Close
Word.Quit

Application.DisplayAlerts = True

With ActiveSheet
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    'For Lrow = Lastrow To 1 Step -1
        'With .Cells(Lrow, "A")
            'If IsError(Application.Match(.Value, ArrNames, 0)) Then .ClearContents
        'End With
    'Next Lrow
    For Lrow = Lastrow To 1 Step -1
        With .Cells(Lrow, "A")
            If Not IsError(Application.Match(.Value, ArrNames, 0)) Then .ClearContents
        End With
    Next Lrow
End With

End Sub

如您所见,我只是从以前的代码中复制了代码的循环部分,并注释掉了我当前未使用的部分。

0 个答案:

没有答案