- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 17# Jason80Lo
¸Õ¸Õ¬Ý- Option Explicit
- Private Sub EX()
- Dim xPath As String, Rng(1 To 2) As Range, xFile As String, a As Variant, r As String
- Dim i As Boolean, f As Integer, xString, xMatch As Variant
- Dim S As Worksheet, AR(), x_Row As Integer
-
- If Join(AR, "") = "" Then ReDim AR(0) '¬°ªÅ°}¦C,°}¦C«Å§i¬°¤@¤¸¯À
- If IsArray([xFile_Add]) Then AR = [xFile_Add] '·í¬¡¶Ã¯ªº¦WºÙ¬O°}¦C
- ' [xFile_Add] -> [³o¬¡¶Ã¯ªº¦WºÙ©Î¨ç¼Æ]
- Set S = ActiveWorkbook.ActiveSheet
- Set Rng(1) = S.Rows(1) '¨Ï¥Î¤¤¬¡¶Ã¯,³o¤u§@ªíªº²Ä¤@¦C
- xPath = "C:\Users\j\Desktop\·s¼W¸ê®Æ§¨ (4)\" 'txt Àɮתº¥Ø¿ý
- xFile = Dir(xPath & "*.txt") '·j´MªþÀɦW
- Do While xFile <> "" '§ä¨ì
- xMatch = Application.Match(xFile, AR, 0) '°}¦C¤¤·j´M
- If IsError(xMatch) Then '°}¦C¤¤·j´M¨S¦³³otxtÀÉ
- If Join(AR, "") = "" Then
- AR(0) = xFile '°}¦C²Ä¤@¤¸¯À=xFile
- Else
- ReDim Preserve AR(0 To UBound(AR) + 1) '°}¦C¤W¤¸¯À+1
- AR(UBound(AR)) = xFile
- End If
- Set Rng(2) = Rng(1).Cells(Application.CountA(Rng(1)) + 1) '¨Ì§Ç¦b²Ä¤@¦C¤¤
- i = True
- Rng(2).Cells = xFile 'ÀɦW¼g¤JÀx¦s®æ¤¤
- f = FreeFile
- Open xPath & xFile For Input Access Read As #1 '¶}±Ò¤å¦rÀÉ
- Do Until EOF(1) '°õ¦æ°j°éª½¨ìÀɧÀ¬°¤î¡C
- Line Input #1, xString '±N¸ê®ÆŪ¤JÅܼƤ¤¡C
- a = Split(xString, Space(1)) '¸ÓÀÉ®×¥H,¬°¤À¹j²Å¸¹
- 'Split ªº«¬ºAVariant
- If i Then
- Rng(2).Cells(2, 1).Resize(UBound(a) + 1) = Application.Transpose(a)
- i = 0
- Else
- With Rng(2).End(xlDown).Offset(1)
- .Resize(UBound(a) + 1) = Application.Transpose(a)
- End With
- End If
- Loop
- Close #f ' Ãö³¬ÀɮסC
- End If
- xFile = Dir '¬d¤U¤@Ó txtÀÉ
- Loop
- If Join(AR, "") <> "" Then ThisWorkbook.Names.Add "xFile_Add", AR '³o¬¡¶Ã¯ªº¦WºÙ ¤º®e¬°³o°}¦C,
- End Sub
½Æ»s¥N½X |
|