Hsieh

¦^´_ 1# stephen


Sub get_file()
fs = Dir("C:\®à­±¥¿½T¸ô®|\*.*")
Do Until fs = ""
r = r + 1
Cells(r, 1) = fs
fs = Dir
Loop
End Sub

Hsieh

¦^´_ 4# b9208

1. Sub Sort_Data()
   
2. Dim Ar(), Ay()
   
3. fd = "E:\" '«ü©w¸ê®Æ§¨
   
4. fs = Dir(fd & "*.xls") '«ü©w°ÆÀɦW
   
5. Do Until fs = ""
   
6. ReDim Preserve Ay(x)
   
7. Ay(x) = fs
   
8. x = x + 1
   
9. fs = Dir
   
10. Loop
    
11. For Each a In Array("QWER", "ASDG", "FGHY", "Other Item")
    
12.    For i = LBound(Ay) To UBound(Ay)
    
13.        If Ay(i) Like "*" & a & "*" Then
    
14.        ReDim Preserve Ar(s)
    
15.        Ar(s) = Array("P" & s + 1, Ay(i))
    
16.        Ay(i) = ""
    
17.        s = s + 1
    
18.        ElseIf a = "Other Item" And Ay(i) <> "" Then
    
19.        ReDim Preserve Ar(s)
    
20.        Ar(s) = Array("P" & s + 1, Ay(i))
    
21.        s = s + 1
    
22.        End If
    
23.    Next
    
24. Next
    
25. [A8:B65536] = ""
    
26. [A8].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
27. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 6# b9208


    ¨º¨SÃö«Y¤~¹ï
°£«D«ü©wªºªþÀɦW¿ù»~®Ú¥»¨S§ì¨ì³o¨ÇÀɦW