Arrays 删除数组中的目录

我有这段代码，可以获取所有文件类型

Dim file as variant
file = Application.GetOpenFilename("All Files, *.*", , "Select File", , True)

然后我必须把它打印在一张纸上的单元格里

For i = 1 To UBound(file)
    lRow = Cells(Rows.count, 15).End(xlUp).Row
    lRow = lRow + 1

    ThisWorkbook.Sheets("Main").Range("O" & lRow).Value = CStr(file(i))
Next i

但是我想要的是首先检查数组的内容。如果数组具有此文件类型，则必须在arraylist中删除它。之后，将弹出一条消息，说明此文件已删除

dim arr() as string
arr = Split("ade|adp|app|asp|bas|bat|cer|chm|cmd|com|cpl|crt|csh|der|exe|fxp|gadget|hlp|hta|inf|ins|isp|its|js|jse|" _
& "ksh|lnk|mad|maf|mag|mam|maq|mar|mas|mat|mau|mav|maw|mda|mdb|mde|mdt|mdw|mdz|msc|msh|msh1|msh2|" _
& "mshxml|msh1xml|msh2xml|ade|adp|app|asp|bas|bat|cer|chm|cmd|com|cpl|crt|csh|der|exe|fxp|gadget|hlp|" _
& "hta|msi|msp|mst|ops|pcd|pif|plg|prf|prg|pst|reg|scf|scr|sct|shb|shs|ps1|ps1xml|ps2|ps2xml|psc1|psc2|tmp|url|vb|vbe|vbs|vsmacros|vsw|ws|wsc|wsf|wsh|xnk", "|")

---

我只是不知道从哪里开始。我也发现了一点同样的问题，但我就是不明白。谢谢

您可以使用

RegExp

和varaint数组快速执行此操作

此代码查找路径。。。点扩展名结束字符串，因此它比当前数组更健壮，当前数组可能基于路径名而不是文件类型删除文件

Sub B()
Dim fName As Variant
Dim objRegex As Object
Dim lngCnt As Long
Dim rng1 As Range

Set objRegex = CreateObject("vbscript.regexp")

On Error Resume Next
fName = Application.GetOpenFilename("All Files, *.*", , "Select file", , True)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0

With objRegex
 .Pattern = ".*\.(ade|adp|app|asp|bas|bat|cer|chm|cmd|com|cpl|crt|csh|der|exe|fxp|gadget|hlp|hta|inf|ins|isp|its|js|jse|" _
& "ksh|lnk|mad|maf|mag|mam|maq|mar|mas|mat|mau|mav|maw|mda|mdb|mde|mdt|mdw|mdz|msc|msh|msh1|msh2|" _
& "mshxml|msh1xml|msh2xml|ade|adp|app|asp|bas|bat|cer|chm|cmd|com|cpl|crt|csh|der|exe|fxp|gadget|hlp|" _
& "hta|msi|msp|mst|ops|pcd|pif|plg|prf|prg|pst|reg|scf|scr|sct|shb|shs|ps1|ps1xml|ps2|ps2xml|psc1|psc2|tmp|url|vb|vbe|vbs|vsmacros|vsw|ws|wsc|wsf|wsh|xnk)$"
    `replace matching file types with blank array entries
    For lngCnt = 1 To UBound(fName)
       fName(lngCnt) = .Replace(fName(lngCnt), vbNullString)
    Next
End With

Set rng1 = Cells(Rows.Count, 15).End(xlUp).Offset(1,0)
'dump array to sheet
rng1.Resize(UBound(fName), 1) = Application.Transpose(fName)
` remove blank entries
On Error Resume Next
rng1.SpecialCells(xlCellTypeBlanks).Delete xlUp
On Error GoTo 0

End Sub

subb（）
Dim fName作为变体
作为对象的Dim objRegex
暗长
变暗rng1 As范围
设置objRegex=CreateObject（“vbscript.regexp”）
出错时继续下一步
fName=Application.GetOpenFilename（“所有文件，*.*，”选择文件“，True）
如果错误号为0，则退出子系统
错误转到0
用objRegex
.Pattern=“.*”。（ade|adp | app | asp | bas | bat | cer | chm | cmd | com | cpl | crt | csh | der | exe | fxp gadget | hlp | hta | inf | ins | isp | its | js js jse |”_
&“ksh | lnk | mad | maf | mam | maq | mas | mat | mau | mav | maw | mdb | mde | mdt | mdw | mdz | msc | msh | msh1 msh2”_
&“mshxml | msh1xml | msh2xml | adp | app | asp | bas | bat | cer | chm | cmd | com | cpl | crt | csh | der | exe | fxp | gadget | hlp |”_
&“hta| msi| msp| msp| mst| mst| mst| mst|CMA| MSA| msp| msp| msp| msp| mst| mst| mst | mst| mst运营运营运营运营商和pcd | pcd| pif| pif| plg| plg | plg| plg| plg| plg| plg| plg| plg | plg 124政政政政政政公公公公公公公公、PSG | PSG | PSG | PSWSF | wsh | xnk）$”
`用空白数组项替换匹配的文件类型
对于lngCnt=1至UBound（fName）
fName（lngCnt）=.Replace（fName（lngCnt），vbNullString）
下一个
以
设置rng1=单元格（Rows.Count，15）。结束（xlUp）。偏移量（1,0）
'将数组转储到工作表
rng1.Resize（UBound（fName），1）=Application.Transpose（fName）
`删除空白条目
出错时继续下一步
rng1.SpecialCells（xlCellTypeBlanks）。删除xlUp
错误转到0
端接头

一种方法是使用

InStr

检查扩展名是否不在黑名单中：

Const exts = _
  ".ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp.gadget" & _
  ".hlp.hta.inf.ins.isp.its.js.jse.ksh.lnk.mad.maf.mag.mam.maq.mar.mas.mat" & _
  ".mau.mav.maw.mda.mdb.mde.mdt.mdw.mdz.msc.msh.msh1.msh2.mshxml.msh1xml" & _
  ".msh2xml.ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp" & _
  ".gadget.hlp.hta.msi.msp.mst.ops.pcd.pif.plg.prf.prg.pst.reg.scf.scr.sct" & _
  ".shb.shs.ps1.ps1xml.ps2.ps2xml.psc1.psc2.tmp.url.vb.vbe.vbs.vsmacros.vsw" & _
  ".ws.wsc.wsf.wsh.xnk."

Dim file As Variant
file = Application.GetOpenFilename("All Files, *.*", , "Select File", , True)

Dim i As Long, data(), count As Long, ext As String
ReDim data(1 To UBound(file) + 1, 1 To 1)

' filter the list
For i = LBound(file) To UBound(file)
  ext = LCase(Mid(file(i), InStrRev(file(i), ".")))
  If InStr(1, exts, ext & ".") = 0 Then  ' if not blacklisted
    count = count + 1
    data(count, 1) = file(i)
  End If
Next

' copy the filtered list to the next available row in column "O"
If count Then
  With ThisWorkbook.Sheets("Main").Cells(Rows.count, "O").End(xlUp)
    .Offset(1).Resize(count).Value = data
  End With
End If

---

如链接所示，你看过吗？@DragonSamu对不起，我不熟悉它。到目前为止，我还在用它学习，但就是无法吸收。谢谢如果我必须删除单元格，它下面仍然有数据，也将被删除。感谢增加范围+1的一种方法？因为包含数据的最后一行被覆盖并替换为新的。有没有办法在最后弹出一条消息？删除的目录或文件是什么？是的，将每个被排除的文件写入一个新数组，然后用

MsgBox Join（excludedList，vbCrLf）

打印结果。我添加了这一行

excludedFile（UBound（excludedFile））=文件（i）将excludedFile（1到UBound（excludedFile）+1）重新定义为字符串

，但表示下标超出范围。我这样做对吗？谢谢