我目前有一段过去的代码...
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
如您所见,我只是从以前的代码中复制了代码的循环部分,并注释掉了我当前未使用的部分。