ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

·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:

test1.rar (75.29 KB)

ÀÉ®×&¸ê®Æ§¨

¦^´_ 1# ¤Ú§J´µ
  1. Sub ¦C¥X©ú²Ó2()
  2.     [B1] = ActiveWorkbook.Path
  3.     Range([a4], [f65536]).ClearContents
  4.     Range([a4], [f65536]).Interior.ColorIndex = xlNone

  5.     Dim fs, fd
  6.     Set fs = CreateObject("Scripting.FileSystemObject")
  7.     Set fd = fs.GetFolder([B1].Value)
  8.    
  9.     FilesHierarchy fd, "x"
  10. End Sub

  11. Sub FilesHierarchy(fd, hierarchy As String)
  12.     Dim i As Long
  13.     With fd
  14.         Cells(Rows.Count, 1).End(xlUp).Cells(2, 1).Resize(1, 4) = Array(hierarchy, .Name, .ParentFolder.Path, "¸ê®Æ§¨")
  15.         For Each x In .SubFolders
  16.             i = i + 1
  17.             FilesHierarchy x, hierarchy & "." & i   'recursive call
  18.         Next
  19.         For Each x In .Files
  20.             i = i + 1
  21.             Cells(Rows.Count, 1).End(xlUp).Cells(2, 1).Resize(1, 4) = Array(hierarchy & "." & i, x.Name, .Path, "ÀÉ®×")
  22.         Next
  23.     End With
  24. End Sub
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

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

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

ÁÂÁÂ

test1-1.rar (35.99 KB)

TOP

¦^´_ 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
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

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

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

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

test1.rar (33.09 KB)

TOP

¦^´_ 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. Dim fs, fd
  7. Set fs = CreateObject("Scripting.FileSystemObject")
  8. Set fd = fs.GetFolder([b1].Value)  '®Ú¥Ø¿ý
  9.    
  10. FilesHierarchy fd, "x"
  11. Range([a4], Cells([a65536].End(3).Row, 6)).Borders.LineStyle = 1
  12. Range([a4], [a65536].End(3)).RowHeight = 24

  13. Dim cOffset As Long, ar
  14. For r = 4 To [a65536].End(3).Row     '§@¾ðª¬¹Ï
  15.     ar = Split(Cells(r, 1), ".")
  16.     cOffset = UBound(ar)  '¶¥¼h¼Æ
  17.     With Cells(r, 8 + cOffset)
  18.         .Value = Cells(r, 3)
  19.         .Interior.ColorIndex = IIf(Cells(r, 2) = "¸ê®Æ§¨", 36, xlNone)
  20.         .Borders(xlEdgeBottom).LineStyle = xlContinuous
  21.         .Borders(xlEdgeBottom).Weight = xlThick
  22.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
  23.     End With
  24.    
  25.     If ar(cOffset) <> "x" And ar(cOffset) <> "1" Then
  26.         For i = r - 1 To 4 Step -1
  27.             If Cells(i, 8 + cOffset) <> "" Then Exit For
  28.             Cells(i, 8 + cOffset).Borders(xlEdgeLeft).LineStyle = xlContinuous
  29.         Next
  30.     End If
  31.    
  32. Next
  33. Application.ScreenUpdating = True
  34. End Sub
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

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

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD