未达目的：用dir在A列音频B列视频列目录

weiyingde

代码如下：
Sub 用dir在A列音频B列视频列目录()
Dim arr(), brr()
s1 = ".mp3.WMA.WAV.mid.OGG.APE.ACC." '音频文件
    flnm = Dir(ThisWorkbook.Path & "\音视频\*.*")
    Do While flnm <> ""
        If InStr(s1, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
           n = n + 1
           ReDim Preserve arr(1 To n)
           flnm = Dir
           arr(n) = flnm
           
        Else
           m = m + 1
           ReDim Preserve brr(1 To m)
           flnm = Dir
           brr(m) = flnm
        End If
    Loop
    Sheets("sheet2").Range("A1").Resize(UBound(arr), 1) = Excel.Application.Transpose(arr) '音频文件
    Sheets("sheet2").Range("B1").Resize(UBound(brr), 1) = Excel.Application.Transpose(brr) '视频文件
End Sub
附件如下：

6688

If InStr(s1, right(flnm,4)) > 0 then

huang1314wei

Do While flnm <> ""
        If InStr(s1, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
            Debug.Print Split(flnm, ".")(UBound(Split(flnm, ".")))
           n = n + 1
           ReDim Preserve arr(1 To n)
           arr(n) = flnm
        Else
           m = m + 1
           ReDim Preserve brr(1 To m)
           brr(m) = flnm
        End If
        flnm = Dir
    Loop

你不能把  flnm = Dir  放在数组赋值的前面的，你放在前面，flnm=dir 只要一执行flnm就变了文件名字，这句代码一运行就把另一个没有受判断的文件名赋给数组了

weiyingde

huang1314wei 发表于 2017-9-21 22:30
Do While flnm  ""
        If InStr(s1, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
       ...

谢谢你，我对dir的使用和理解还是很糊涂的。
现在，我试着按照自己的思路写代码，其中难免会出现很多很幼稚的问题，还多时候还需要黄老师点拨点拨。

weiyingde

6688 发表于 2017-9-21 18:23
If InStr(s1, right(flnm,4)) > 0 then

谢谢指教。谢谢顶贴

weiyingde

自己用三个数组解决，但是很是繁琐。
Sub 列目录()
On Error Resume Next
Dim arr(), brr(), crr()
s1 = ".mp3.WMA.WAV.wma.wav.mid.OGG.APE.ACC." '音频文件
    flnm = Dir(ThisWorkbook.Path & "\音视频\*.*")
    Do While flnm <> ""
           n = n + 1
           ReDim Preserve arr(1 To n)
           flnm = Dir
           arr(n) = flnm
    Loop
        For i = LBound(arr) To UBound(arr)
           If InStr(s1, Split(arr(i), ".")(UBound(Split(arr(i), ".")))) > 0 Then
              m = m + 1
              ReDim Preserve brr(1 To m)
              brr(m) = arr(i)
           Else
              k = k + 1
              ReDim Preserve crr(1 To k)
              crr(k) = arr(i)
           End If
        Next
    Sheets("sheet2").Range("A1").Resize(UBound(brr), 1) = Excel.Application.Transpose(brr) '音频文件
    Sheets("sheet2").Range("B1").Resize(UBound(crr), 1) = Excel.Application.Transpose(crr) '视频文件
End Sub

weiyingde

借用黄老师思路，用三个数组，把三类文件分列在三个列上。
Sub 用dr在A列音频B列视频列目录()
Dim arr(), brr(), crr()
s1 = ".mp3.WMA.WAV.wma.wav.mid.OGG.APE.ACC." '音频文件
s2 = ".3gp.ts.swf.tp.ifo.nsv.tta.as3."
s3 = ".mp4.mp5.wkv.avi.wmv.flv.f4v.rm.rmvb.rmv.dat.asf.mov.vob."
    flnm = Dir(ThisWorkbook.Path & "\音视频\*.*")
    Do While flnm <> ""
        If InStr(s1, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
           n = n + 1
           ReDim Preserve arr(1 To n)
           arr(n) = flnm
        ElseIf InStr(s2, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
           m = m + 1
           ReDim Preserve brr(1 To m)
           brr(m) = flnm
        ElseIf InStr(s3, Split(flnm, ".")(UBound(Split(flnm, ".")))) > 0 Then
           p = p + 1
           ReDim Preserve crr(1 To p)
           crr(p) = flnm
        End If
        flnm = Dir
    Loop
    Sheets("sheet2").Range("A1").Resize(UBound(arr), 1) = Excel.Application.Transpose(arr) '音频文件
    Sheets("sheet2").Range("B1").Resize(UBound(brr), 1) = Excel.Application.Transpose(brr) '视频文件
    Sheets("sheet2").Range("c1").Resize(UBound(crr), 1) = Excel.Application.Transpose(crr)
End Sub

huang1314wei

weiyingde 发表于 2017-9-22 22:02
借用黄老师思路，用三个数组，把三类文件分列在三个列上。
Sub 用dr在A列音频B列视频列目录()
Dim arr(), ...

又看到你这个问题了，为什么不用一个N行3列的二维数组搞定呢？

weiyingde

huang1314wei 发表于 2017-9-22 22:10
又看到你这个问题了，为什么不用一个N行3列的二维数组搞定呢？

是的，经你提醒倒是很好的建议。
很多时候，我都是一根筋，解决一个眼前问题，很少从技术层面上提高代码简洁和效率，黄老师这一说，倒是一语点拨梦中人。
当然还有一点，那就是数组和字典，我还是一知半解。
虽然，接触VBA有些时日，相对于论坛上很多新手来说，现在已经是“老手”了；但面对很多技术上的后来居上者，很是惭愧：技术一直未曾见长。
随着岁月的流逝，眼睛老化越来越严重，实力很不好使，精力、身体、心思等等原因，决定了学VBA一直停留在解决眼前“小问题”的功力目的和使用一些简单思路达到目标的低级层面上，所有很少有参与帮人解惑从而获取练手的机会，这是我的VBA水平未曾见长的一个主要原因。
若想有一个安静的心境沉醉于所爱VBA钻研之中，恐怕要到退休之后（我是多么想有王金国老师那样的身体和闲暇在退休之后还能畅游ExcelHome 论坛的惬意啊，但愿到时如愿）。
再次谢谢黄老师的关注！
谢谢你一直以来的帮助。

weiyingde

huang1314wei 发表于 2017-9-22 22:10
又看到你这个问题了，为什么不用一个N行3列的二维数组搞定呢？

是的，你提醒倒是很好的建议。
很多时候，我都是一根筋，解决一个眼前问题，很少从技术层面上提高代码简洁和效率，黄老师这一说，倒是一语点拨梦中人。
当然还有一点，那就是数组和字典，我还是一知半解。
虽然，接触VBA有些时日，相对于论坛上很多新手来说，现在已经是“老手”了；但面对很多技术上的后来居上者，很是惭愧：技术一直未曾见长。
随着岁月的流逝，眼睛老化越来越严重，实力很不好使，精力、身体、心思等等原因，决定了学VBA一直停留在解决眼前“小问题”的功力目的和使用一些简单思路达到目标的低级层面上，所以很少有参与帮人解惑从而获取练手的机会，这是我的VBA水平未曾见长的一个主要原因。
若想有一个安静的心境沉醉于所爱VBA钻研之中，恐怕要到退休之后（我是多么想有王金国老师那样的身体和闲暇在退休之后还能畅游ExcelHome 论坛的惬意啊，但愿到时如愿）。
再次谢谢黄老师的关注！
谢谢你一直以来的帮助。