[µo°Ý] ½Ð±Ð¦p¦ó¦C¥X©Ò¦³ªº¤l¸ê®Æ§¨¦W

¤Ú§J´µ

·Q­n±N«ü©w¸ê®Æ§¨¤ºªº©Ò¦³¤l¸ê®Æ§¨¤ÎÀɦW¦C¥X
¥Ø«e¥i¥H±NÀɮצC¥X¤F,¥i¬O¤£·|¦C¥X©Ò¦³ªº¤l¸ê®Æ§¨¦W
²Ó³¡»¡©ú¤ÎÀɮשóªþÀɤ¤

¨D§U¬O§_¥i¹F¦¨¦¹¥\¯à?
·PÁÂÀ°¦£:loveliness:

¤Ú§J´µ

·PÁÂstillfish00
¤j³¡¤Àªº°ÝÃD³£¸Ñ¨M¤F
¦Ó¥B¾Ç¨ìºë²ªº¼gªk,¨ü¯q¨}¦h

stillfish00

¦^´_ 5# ¤Ú§J´µ

1. Sub ¦C¥X©ú²Ó()
   
2. [b1] = ActiveWorkbook.Path
   
3. Range([a4], [f65536]).ClearContents
   
4. [a4:a65536].EntireRow.Delete
   
5. Application.ScreenUpdating = False
   
6. 
   
7. Dim fs, fd
   
8. Set fs = CreateObject("Scripting.FileSystemObject")
   
9. Set fd = fs.GetFolder([b1].Value)  '®Ú¥Ø¿ý
   
10.    
    
11. FilesHierarchy fd, "x"
    
12. Range([a4], Cells([a65536].End(3).Row, 6)).Borders.LineStyle = 1
    
13. Range([a4], [a65536].End(3)).RowHeight = 24
    
14. 
    
15. Dim cOffset As Long, ar
    
16. For r = 4 To [a65536].End(3).Row     '§@¾ðª¬¹Ï
    
17.     ar = Split(Cells(r, 1), ".")
    
18.     cOffset = UBound(ar)  '¶¥¼h¼Æ
    
19.     With Cells(r, 8 + cOffset)
    
20.         .Value = Cells(r, 3)
    
21.         .Interior.ColorIndex = IIf(Cells(r, 2) = "¸ê®Æ§¨", 36, xlNone)
    
22.         .Borders(xlEdgeBottom).LineStyle = xlContinuous
    
23.         .Borders(xlEdgeBottom).Weight = xlThick
    
24.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
    
25.     End With
    
26.    
    
27.     If ar(cOffset) <> "x" And ar(cOffset) <> "1" Then
    
28.         For i = r - 1 To 4 Step -1
    
29.             If Cells(i, 8 + cOffset) <> "" Then Exit For
    
30.             Cells(i, 8 + cOffset).Borders(xlEdgeLeft).LineStyle = xlContinuous
    
31.         Next
    
32.     End If
    
33.    
    
34. Next
    
35. Application.ScreenUpdating = True
    
36. End Sub

½Æ»s¥N½X

¤Ú§J´µ

¦^´_ 4# stillfish00
·PÁÂstillfish00

¾ðª¬½u¸É¨¬ok¤F
¤£¹L¦³³¡¤À½u¦h¥X¨Ó

·Q¤£¥X¦³®Äªº¤èªk¥h°£
¦A°Q±Ð(¦pªþ¥ó),·PÁÂ

stillfish00

¦^´_ 3# ¤Ú§J´µ

1. Dim cOffset As Long
   
2. For r = 4 To [a65536].End(3).Row
   
3.     cOffset = UBound(Split(Cells(r, 1), "."))
   
4.     With Cells(r, 8 + cOffset)
   
5.         .Value = Cells(r, 3)
   
6.         .Interior.ColorIndex = IIf(Cells(r, 2) = "¸ê®Æ§¨", 36, xlNone)
   
7.         .Borders(xlEdgeBottom).LineStyle = xlContinuous
   
8.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
   
9.     End With
   
10.     For c = 9 To 8 + cOffset - 1
    
11.         Cells(r, c).Borders(xlEdgeLeft).LineStyle = xlContinuous
    
12.     Next
    
13. Next
    
14. Application.ScreenUpdating = True

½Æ»s¥N½X

¤Ú§J´µ

¦^´_ 1# ¤Ú§J´µ
·PÁÂstillfish00
«Üºë²ªºµ{¦¡´N¸Ñ¨M°ÝÃD¤F

§ÚÄ~Äò·Q°µ¾ðª¬¹Ïªº³¡¤À
«áÄò¦³³¡¤À¤£·|·Q¦A½Ð¨ó§U§¹¦¨
¤]§ó·Q¬Ý¬Ý·|¥H­þºØºë½mªºµ{¦¡¥i¥H¹F¦¨
²Ó¶µ»¡©ú½Ð¬Ýªþ¥ó

ÁÂÁÂ

stillfish00

¦^´_ 1# ¤Ú§J´µ

1. Sub ¦C¥X©ú²Ó2()
   
2.     [B1] = ActiveWorkbook.Path
   
3.     Range([a4], [f65536]).ClearContents
   
4.     Range([a4], [f65536]).Interior.ColorIndex = xlNone
   
5. 
   
6.     Dim fs, fd
   
7.     Set fs = CreateObject("Scripting.FileSystemObject")
   
8.     Set fd = fs.GetFolder([B1].Value)
   
9.    
   
10.     FilesHierarchy fd, "x"
    
11. End Sub
    
12. 
    
13. Sub FilesHierarchy(fd, hierarchy As String)
    
14.     Dim i As Long
    
15.     With fd
    
16.         Cells(Rows.Count, 1).End(xlUp).Cells(2, 1).Resize(1, 4) = Array(hierarchy, .Name, .ParentFolder.Path, "¸ê®Æ§¨")
    
17.         For Each x In .SubFolders
    
18.             i = i + 1
    
19.             FilesHierarchy x, hierarchy & "." & i   'recursive call
    
20.         Next
    
21.         For Each x In .Files
    
22.             i = i + 1
    
23.             Cells(Rows.Count, 1).End(xlUp).Cells(2, 1).Resize(1, 4) = Array(hierarchy & "." & i, x.Name, .Path, "ÀÉ®×")
    
24.         Next
    
25.     End With
    
26. End Sub

½Æ»s¥N½X