Board logo

標題: [發問] 關於Dir 取得的清單做排序，感謝~ [打印本頁]
作者: ui123    時間: 2014-3-3 19:46     標題: 關於Dir 取得的清單做排序，感謝~

各位大大，最近我有寫了一個簡單的VBA,如下:
我是想要在   myFile = Dir(myFolder & "*.xlsx") 時即由名稱小到大，開始做接下來的動作。
但有的時候會發生名稱可能由大到小來進行接下來的動作，很奇怪，各位大大知道這是什麼造成的嗎?
很困惱我需要名稱是由小到大的順序做動作，感謝你們，謝謝!~:'(

Sub file()
    Dim myFolder As String, myFile As String
    Dim i As Integer
    myFolder = "C:\New folder\"
    myFile = Dir(myFolder & "*.xlsx") '就是這裡，想名稱由小到大
    i = 1
    Do While myFile <> ""
        Cells(i, 1).Value = myFile
        myFile = Dir()
        i = i + 1
    Loop
End Sub
作者: ui123    時間: 2014-3-3 20:19

還是可以再設一個名 稱清單為 myFile2= myFile的排序
然後:
  i = 1
    Do While myFile2 <> ""
        Cells(i, 1).Value = myFile2
        myFile2 = Dir()
        i = i + 1
    Loop

不知道行得通嗎?問不到人.....感恩
作者: kimbal    時間: 2014-3-3 21:59

回復 2# ui123
    Dir 不能指定排列, 但可以在DIR得出後排序
  1. Sub file()
  2.     Dim myFolder As String, myFile As String
  3.     Dim i As Integer
  4.     myFolder = "C:\temp\"
  5.     myFile = Dir(myFolder & "*.xlsx")
  6.     i = 1
  7.     Do While myFile <> ""
  8.         Cells(i, 1).Value = myFile
  9.         myFile = Dir()
  10.         i = i + 1
  11.     Loop
  12.     With ActiveSheet.Sort
  13.         .SetRange Range("A:A")
  14.         .Header = xlNo
  15.         .MatchCase = False
  16.         .Orientation = xlTopToBottom
  17.         .Apply
  18.     End With

  20. End Sub
複製代碼
作者: ui123    時間: 2014-3-3 22:15

kimbal 謝謝您，
但有辦法在VBA程式內做到嗎?
因為想列一個排好大小順序的清單給接下來的迴圈使用，您用的方式我了解(先列出清單在excel sheet 中，然後再排序)，但我還是想用VBA中寫成!
--------------------------------------------------------------------------------------------
我有查到在Dos 下的目錄顯示(DIR)，可以依照指定的排序順序來列出檔案，如下網址。而VBA尚無找到:
http://jax-work-archive.blogspot.tw/2009/04/dos-dir.html
感恩^  ^~
作者: ui123    時間: 2014-3-4 11:16

對於之前問的問題：
但有的時候會發生名稱可能由大到小來進行接下來的動作，很奇怪，各位大大知道這是什麼造成的嗎?

我發現在XP時是檔案更新的日期由"新→舊"作為順序
在Win8時是檔案更新的日期由"舊→新"作為順序

所以想請問各位大大，可以在XP時是檔案更新的日期由"舊→新"作為順序嗎???謝謝~
作者: stillfish00    時間: 2014-3-4 16:11

回復 2# ui123
  1. Sub Test()
  2.   Dim myFolder As String
  3.   Dim oFSO As Object, oFiles As Object, oFile As Object
  4.   Dim i, lCnt As Long
  5.   Dim arFiles()
  6.   
  7.   Const HIDDEN = &H2
  8.   myFolder = "C:\New folder\"
  9.   Set oFSO = CreateObject("Scripting.FileSystemObject")
  10.   Set oFiles = oFSO.getFolder(myFolder).Files
  11.   
  12.   ReDim arFiles(1 To oFiles.Count)
  13.   
  14.   '取出所有檔案
  15.   i = 0
  16.   For Each oFile In oFiles
  17.     If Right(oFile.Name, 5) = ".xlsx" Then
  18.       If (oFile.Attributes And HIDDEN) = 0 Then '不含隱藏檔
  19.         i = i + 1
  20.         arFiles(i) = oFile.Name
  21.       End If
  22.     End If
  23.   Next
  24.   If i = 0 Then MsgBox "Not Found" : Exit Sub
  25.   ReDim Preserve arFiles(1 To i)
  26.   
  27.   'array內排序
  28.   Dim temp, j
  29.   For i = 1 To UBound(arFiles)
  30.     For j = i + 1 To UBound(arFiles)
  31.       If arFiles(i) > arFiles(j) Then
  32.         temp = arFiles(i)
  33.         arFiles(i) = arFiles(j)
  34.         arFiles(j) = temp
  35.       End If
  36.     Next j
  37.   Next i
  38.   'arFiles 即為排序後陣列
  39.   
  40.   MsgBox Join(arFiles, vbCrLf)
  41. End Sub
複製代碼
作者: ui123    時間: 2014-3-4 22:23

回復 6# stillfish00
stillfish00大~很感動，謝謝您的幫忙，我明天去公司試一下~
上次"落點問題"也是你幫我解的，現在我每天都有在用喔! 我都有記得，真的真的~ 謝謝您 ^ ^~



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)