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

[µo°Ý] ¦p¦ó±q¤£¦P¸ê®Æ§¨¶×¤J¤å¦rÀÉ

[µo°Ý] ¦p¦ó±q¤£¦P¸ê®Æ§¨¶×¤J¤å¦rÀÉ

¦U¦ì¤j¤j

¦p¦ó±q¤£¦Pªº¸ê®Æ§¨¶×¤J¤å¦rÀÉ¦Ü sheet1ªíA:JÄæ

·Ð½Ð¥ý¶i«ü¾É!

TEST10.rar (18.93 KB)

¦^´_ 1# luke
  1. Sub xx()
  2. Application.ScreenUpdating = False
  3. Set FT = ActiveWorkbook
  4. For X = 1 To 5
  5.   FS = "D:\LAN" & X & "\LAN" & X & ".CSV"
  6.   With Workbooks.Open(FS).Sheets("LAN" & X)
  7.     FT.Sheets("Sheet1").Columns("A:B").Offset(0, (X - 1) * 2) = .Columns("A:B").Value
  8.     .Parent.Close False
  9.   End With
  10. Next
  11. Application.ScreenUpdating = True
  12. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ luke ©ó 2012-4-15 17:36 ½s¿è

¦^´_ 2# register313


    ÁÂÁÂR¤j

    ­Y¸ê®Æ¦³­×§ï¦p·s¼W¸ê®Æ©ósheet1ªíA:JÄ檺A11:J17
    ¥i§_§ó·sÂà¦s¦^¦Ü­ì¸ê®Æ§¨ªº¤å¦rÀÉ

   A11:B17Äæ¬O·s¼W¥[¸ê®Æ±ýÂà¦s¦ÜD:\LAN1¸ê®Æ§¨LAN1.csvªº1,2Äæ
   C11:D17Äæ¬O·s¼W¥[¸ê®Æ±ýÂà¦s¦ÜD:\LAN2¸ê®Æ§¨LAN2.csvªº1,2Äæ
   E11:F17Äæ¬O·s¼W¥[¸ê®Æ±ýÂà¦s¦ÜD:\LAN3¸ê®Æ§¨LAN3.csvªº1,2Äæ
   G11:H17Äæ¬O·s¼W¥[¸ê®Æ±ýÂà¦s¦ÜD:\LAN4¸ê®Æ§¨LAN4.csvªº1,2Äæ
   I17:J17Äæ¬O·s¼W¥[¸ê®Æ±ýÂà¦s¦ÜD:\LAN5¸ê®Æ§¨LAN5.csvªº1,2Äæ

   ·Ð½Ð¥ý¶i, ¤j¤j«ü¾É
TEST10-1.rar (26.57 KB)

TOP

¦^´_ 3# luke
  1. Sub Âà¤J()
  2. Application.ScreenUpdating = False
  3. Set FT = ActiveWorkbook
  4. For X = 1 To 5
  5.   FS = "D:\LAN" & X & "\LAN" & X & ".CSV"
  6.   With Workbooks.Open(FS).Sheets("LAN" & X)
  7.     FT.Sheets("Sheet1").Columns("A:B").Offset(0, (X - 1) * 2) = .Columns("A:B").Value
  8.     .Parent.Close False
  9.   End With
  10. Next
  11. Application.ScreenUpdating = True
  12. End Sub

  13. Sub 刴X()
  14. Application.ScreenUpdating = False
  15. Set FT = ActiveWorkbook
  16. For X = 1 To 5
  17.   FS = "D:\LAN" & X & "\LAN" & X & ".CSV"
  18.   With Workbooks.Open(FS).Sheets("LAN" & X)
  19.     FT.Sheets("Sheet1").Columns("A:B").Offset(0, (X - 1) * 2).Copy .Columns("A:B")
  20.     .Parent.Close savechanges:=True
  21.   End With
  22. Next
  23. Application.ScreenUpdating = True
  24. End Sub
½Æ»s¥N½X

TOP

¦^´_ 3# luke
  1. Sub InputCSV() 'Ū¤JCSV
  2. Dim ary() As String, rw As Long
  3. i = 0: k = 1
  4. path1 = ThisWorkbook.Path & "\"
  5. file1 = Dir(path1 & "*.*", vbDirectory) '¥u³B²z¸ê®Æ§¨
  6. Do While file1 <> ""
  7.   If file1 <> "." And file1 <> ".." And _
  8.      GetAttr(path1 & file1) = vbDirectory Then
  9.      i = i + 1
  10.      ReDim Preserve ary(i)
  11.      ary(i) = file1
  12.   End If
  13.   file1 = Dir
  14. Loop
  15. For i = 1 To UBound(ary)
  16. path2 = path1 & ary(i) & "\"
  17. fs = Dir(path2 & "*.csv")
  18. Do Until fs = ""
  19. Open path2 & fs For Input As #1
  20. r = 1
  21. Do Until EOF(1)
  22. Line Input #1, mystr
  23. ar = Split(mystr, ",")
  24. Cells(r, k).Resize(, UBound(ar) + 1) = ar
  25. r = r + 1
  26. Loop
  27. k = k + 2
  28. Close #1
  29. fs = Dir
  30. Loop
  31. Next i
  32. End Sub
  33. Sub OutputCSV() '¿é¥XCSV
  34. path1 = ThisWorkbook.Path & "\"
  35. k = 1
  36. Do Until Cells(1, k) = ""
  37.    r = 1
  38.    fs = path1 & Cells(1, k + 1) & "\" & Cells(1, k + 1) & ".csv"
  39.    Open fs For Output As #1
  40.    Do Until Cells(r, k) = ""
  41.       mystr = Cells(r, k) & "," & Cells(r, k + 1)
  42.       Print #1, mystr
  43.       r = r + 1
  44.    Loop
  45.    Close #1
  46.    k = k + 2
  47. Loop
  48. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# register313

   ÁÂÁÂR¤j

   ­Y¸ê®Æ§¨·s¼W¦h¤FD:\LAN0ªºLAN0.csv§Y
   A:B¨âÄæÀx¦s¦ÜD:\LAN0¸ê®Æ§¨ªºLAN0.csv
  C:D¨âÄæÀx¦s¦ÜD:\LAN1¸ê®Æ§¨ªºLAN1.csv
  E:F¨âÄæÀx¦s¦ÜD:\LAN2¸ê®Æ§¨ªºLAN2.csv
  G:H¨âÄæÀx¦s¦ÜD:\LAN3¸ê®Æ§¨ªºLAN3.csv
  I:J¨âÄæÀx¦s¦ÜD:\LAN4¸ê®Æ§¨ªºLAN4.csv
  K:L¨âÄæÀx¦s¦ÜD:\LAN5¸ê®Æ§¨ªºLAN5.csv

  ·Ð½Ð¥ý¶i, ¤j¤j«ü¾É¦p¦ó­×§ï?

TEST10-1A.rar (25.6 KB)

TOP

¦^´_ 6# luke
  1. Sub Âà¤J()
  2. Application.ScreenUpdating = False
  3. Set FT = ActiveWorkbook
  4. For X = 0 To 5
  5.   fs = "D:\LAN" & X & "\LAN" & X & ".CSV"
  6.   With Workbooks.Open(fs).Sheets("LAN" & X)
  7.     FT.Sheets("Sheet1").Columns("A:B").Offset(0, X * 2) = .Columns("A:B").Value
  8.     .Parent.Close False
  9.   End With
  10. Next
  11. Application.ScreenUpdating = True
  12. End Sub

  13. Sub 刴X()
  14. Application.ScreenUpdating = False
  15. Set FT = ActiveWorkbook
  16. For X = 0 To 5
  17.   fs = "D:\LAN" & X & "\LAN" & X & ".CSV"
  18.   With Workbooks.Open(fs).Sheets("LAN" & X)
  19.     FT.Sheets("Sheet1").Columns("A:B").Offset(0, X * 2).Copy .Columns("A:B")
  20.     .Parent.Close savechanges:=True
  21.   End With
  22. Next
  23. Application.ScreenUpdating = True
  24. End Sub
½Æ»s¥N½X

TOP

¦^´_ 5# Hsieh


    ÁÂÁÂH¤j

    Ū¤JCSVÀɮ׮Ƨ¨¤º¦³Ãþ¦ü¦WºÙ, ¦pD:\LAN0¸ê®Æ§¨¤º¦³LAN0.csv©MLAN6.csv¨â­Ó¤å¦rÀÉ®É,
    LAN6.csv¤]·|³Q¶×¤J(¥u»Ý¶×¤JLAN0.csv)

    ¶i¦æ¿é¥XCSV®É, ¸ÓLAN6.csv§ä¤£¨ì¸ô®|·|¥X²{¿ù»~

   
     ¥H¤WÀ³¦p¦óÁקK¿ù»~
     ·Ð½Ð¥ý¶i«ü¾É
      TEST1B.rar (22.74 KB)

TOP

¦^´_ 7# register313


    ÁÂÁÂR¤j

    ­Y·Q±NÂà¥X«áªº¸ê®Æ§¨(³s¦P¤å¦rÀÉ), «ö¤Usheet1ªí"À£ÁY"«ö¶s¨Ó¤À§O§@¸ê®Æ§¨À£ÁY
     ¦pLAN0¸ê®Æ§¨À£ÁY¦¨LAN0.rar

     ·Ð½Ð¥ý¶i, ¤j¤j«ü¾É
       TEST10-2A.rar (33.86 KB)

TOP

¦^´_ 9# luke
  1. Sub ZipAsWb2() 'À£ÁY¦¨Zip
  2. '°Ñ¦Òcrdotlin«e½úhttp://blog.xuite.net/crdotlin/excel/20830799-%E4%B8%80%E6%AC%A1%E6%80%A7%E6%9B%BF%E6%8F%9B
  3. Dim ZipFile, srFolder, nFile, ofile
  4. Dim theShell As Object
  5.     '«ü©w¨Ó·½Àɮתº¸ê®Æ§¨
  6.     f = ThisWorkbook.Path
  7.     srFolder = f
  8.     'Àˬd¸ê®Æ§¨¬O§_¦s¦b
  9.     Set theShell = CreateObject("Shell.Application")
  10.     If theShell.Namespace(srFolder) Is Nothing Then
  11.         MsgBox srFolder & " ¸ê®Æ§¨¤£¦s¦b!"
  12.         End
  13.     End If
  14.     'Àˬd¬O§_¬°ªÅªº¸ê®Æ§¨
  15.     If theShell.Namespace(srFolder).items.Count = 0 Then
  16.         MsgBox srFolder & " ¸ê®Æ§¨¤¤¨S¥ô¦óÀɮצs¦b!"
  17.         End
  18.     End If
  19.     '¶}±Ò¤@­ÓªÅªºZipÀ£ÁYÀÉ®×
  20.     ZipFile = f & ".zip"
  21.     Open ZipFile For Output As #1
  22.     '¼g¤JZIPÀÉÀY
  23.     Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
  24.     Close #1
  25.     '½Æ»s¨C¤@­Ó¦bzipÀɤ¤ªºÀÉ®×
  26.     On Error Resume Next
  27.     For Each ofile In theShell.Namespace(srFolder).items
  28.         If ofile <> ".zip" Then theShell.Namespace(ZipFile).CopyHere (ofile)
  29.         '²³æ¼È°±1¬íµ¥­Ô½Æ»s§¹¦¨
  30.         Application.Wait Now + 1 / 86400#
  31.     Next
  32. End Sub

  33. Sub InputCSV() 'Ū¤JCSV
  34. Dim ary() As String, rw As Long
  35. i = 0: k = 1
  36. Cells.ClearContents
  37. path1 = ThisWorkbook.Path & "\"
  38. file1 = Dir(path1 & "*.*", vbDirectory) '¥u³B²z¸ê®Æ§¨
  39. Do While file1 <> ""
  40.   If file1 <> "." And file1 <> ".." And _
  41.      GetAttr(path1 & file1) = vbDirectory Then
  42.      i = i + 1
  43.      ReDim Preserve ary(i)
  44.      ary(i) = file1
  45.   End If
  46.   file1 = Dir
  47. Loop
  48. For i = 1 To UBound(ary)
  49. path2 = path1 & ary(i) & "\"
  50. fs = Dir(path2 & "*.csv")
  51. Do Until fs = ""
  52. If Split(fs, ".")(0) = ary(i) Then
  53. Open path2 & fs For Input As #1
  54. r = 1
  55. Do Until EOF(1)
  56. Line Input #1, mystr
  57. ar = Split(mystr, ",")
  58. Cells(r, k).Resize(, UBound(ar) + 1) = ar
  59. r = r + 1
  60. Loop
  61. k = k + 2
  62. Close #1
  63. End If
  64. fs = Dir
  65. Loop
  66. Next i
  67. End Sub
  68. Sub OutputCSV() '¿é¥XCSV
  69. path1 = ThisWorkbook.Path & "\"
  70. k = 1
  71. Do Until Cells(1, k) = ""
  72.    r = 1
  73.    fs = path1 & Cells(1, k + 1) & "\" & Cells(1, k + 1) & ".csv"
  74.    Open fs For Output As #1
  75.    Do Until Cells(r, k) = ""
  76.       mystr = Cells(r, k) & "," & Cells(r, k + 1)
  77.       Print #1, mystr
  78.       r = r + 1
  79.    Loop
  80.    Close #1
  81.    k = k + 2
  82. Loop
  83. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD