Arrays 删除数组中的项
我有这段代码,可以在VBA中浏览所有文件类型。它已经在工作,但我现在要做的是删除数组中的项(如果它是被阻止的文件类型之一)Arrays 删除数组中的项,arrays,vba,excel,Arrays,Vba,Excel,我有这段代码,可以在VBA中浏览所有文件类型。它已经在工作,但我现在要做的是删除数组中的项(如果它是被阻止的文件类型之一) 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" & _ ".m
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."
file = Application.GetOpenFilename(MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(file) = True Then
'Create empty Zip File
ReDim Data(1 To UBound(file) + 1, 1 To 1)
efCount = Empty
' filter the list
For j = LBound(file) To UBound(file)
ext = LCase(Mid(file(j), InStrRev(file(j), ".")))
If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted
count = count + 1
Data(count, 1) = file(j)
Else
ReDim Preserve excludedFile(efCount)
excludedFile(efCount) = Dir(file(j))
efCount = efCount + 1
file(j - 1) = file(j) 'Ive tried this and other ways bu is not working
found = True
End If
Next
谢谢你的帮助。你可以这样做
Dim file As Variant
Dim efCount As Long, j As Long, count As Long
Dim ext As String
Dim found As Boolean
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."
file = Application.GetOpenFilename(MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(file) = True Then
'Create empty Zip File
ReDim Data(1 To UBound(file))
ReDim excludedFile(1 To UBound(file))
efCount = 0
' filter the list
For j = LBound(file) To UBound(file)
ext = LCase(Mid(file(j), InStrRev(file(j), ".")))
If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted
count = count + 1
Data(count) = file(j)
Else
excludedFile(efCount + 1) = Dir(file(j))
efCount = efCount + 1
End If
Next
found = efCount > 0
End If
ReDim Preserve Data(1 To count)
ReDim Preserve excludedFile(1 To efCount)
file = Data
你可以这样走
Dim file As Variant
Dim efCount As Long, j As Long, count As Long
Dim ext As String
Dim found As Boolean
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."
file = Application.GetOpenFilename(MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(file) = True Then
'Create empty Zip File
ReDim Data(1 To UBound(file))
ReDim excludedFile(1 To UBound(file))
efCount = 0
' filter the list
For j = LBound(file) To UBound(file)
ext = LCase(Mid(file(j), InStrRev(file(j), ".")))
If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted
count = count + 1
Data(count) = file(j)
Else
excludedFile(efCount + 1) = Dir(file(j))
efCount = efCount + 1
End If
Next
found = efCount > 0
End If
ReDim Preserve Data(1 To count)
ReDim Preserve excludedFile(1 To efCount)
file = Data
可以使用函数从数组中删除特定值。将此信息放入您的项目中:
Function DeleteElement(x As String, ByRef List() As String) ' As String
Dim i As Integer, el As Integer
Dim Result() As String
ReDim Result(UBound(List) - 1)
For i = 0 To UBound(List)
If x = List(i) Then
el = i
Exit For
End If
Next i
For i = 0 To UBound(Result)
If i < el Then
Result(i) = List(i)
Else
Result(i) = List(i + 1)
End If
Next i
DeleteElement = Result
End Function
可以使用函数从数组中删除特定值。将此信息放入您的项目中:
Function DeleteElement(x As String, ByRef List() As String) ' As String
Dim i As Integer, el As Integer
Dim Result() As String
ReDim Result(UBound(List) - 1)
For i = 0 To UBound(List)
If x = List(i) Then
el = i
Exit For
End If
Next i
For i = 0 To UBound(Result)
If i < el Then
Result(i) = List(i)
Else
Result(i) = List(i + 1)
End If
Next i
DeleteElement = Result
End Function
为什么不使用更容易操作的词典呢?@PankajJaju还没试过,我使用起来还是有困难。谢谢。或者(我想只有Windows)为什么不使用更容易操作的字典呢?@PankajJaju还没有试过,我使用它仍然有困难。谢谢。或者(我想只有窗户)