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

[µo°Ý] VBAµ{¦¡ ¶}±Ò¤@­Ó¬Û¦PÀɦW¤£¦PÀÉ®×

[µo°Ý] VBAµ{¦¡ ¶}±Ò¤@­Ó¬Û¦PÀɦW¤£¦PÀÉ®×

¥»©«³Ì«á¥Ñ èªÎ¯Ì¦Ï ©ó 2022-4-13 14:12 ½s¿è

©êºp·Q¸ß°Ý¦U¦ì:
¦p¦ó¥i¥H¥ý¶}±Ò¤@­Ó¬Û¦PÀɦW¤£¦PÀɮסA±N¸ê®Æ³B²z«á¥t¦s¤@­Ó·sÀɮסA¤§«á¶i¦æ½ü°j¡C
¥Ø«e¤w¦³¦¨¥\¶}±Ò¡A¦ý¥L·|«ö·Ó¸ê®Æ§¨¸Ì­±ªº¤ù¼Æ¥þ¼Æ¶}±Ò

¥H¤U¬O§Úªºvbaµ{¦¡:
   Sub A¶}±ÒÀÉ®×()

    Dim lrow As Long
    Dim mFile As String
    Dim Filename As String
   
    mFile = Dir(ThisWorkbook.Path & "\csvÀÉ\" & "*.csv")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\csvÀÉ\" & mFile
    mFile = Dir()
   
    mFile = Dir(ThisWorkbook.Path & "\TXTÀÉ\" & "*.txt")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\TXTÀÉ\" & mFile
    mFile = Dir()
    Loop
    Loop

End Sub
¦A³Â·ÐÀ°§Ú½T»{¤Î­×§ï...ÁÂÁÂ~~

ÀɮפJ®|

1.jpg
2.jpg
3.png
4.jpg

¦^´_ 1# èªÎ¯Ì¦Ï


¬Ý¤£¤ÓÀ´±zªº»Ý¨D¬°¦ó?¥i¥H¤W¶Çªþ¥ó©M»Ý¨Dµ²ªG¡AÁÂÁÂ
±N¸ê®Æ³B²z«á¥t¦s¤@­Ó·sÀÉ®×>> ¸ê®Æ«ç»ò³B²z?

TOP

¦^´_ 2# samwang


¤£¦n·N«ä»¡©úªº¤£²M·¡¡A¥Ø«e¬O·Q¶}¨â­Ó¬Û¦PÀɮצý¤£¦P°ÆÀɦWCSV»PTXT¡AµM«á¦A±NTXT¸Ì­±ªº¸ê®Æ½Æ»s¦bCSVÀÉ¡AµM«á¥t¦sÀɮצb¶i¦æ½ü°j¡C
¥Ø«e¸ê®Æ³B²z¨ì¥t¦sÀɮפw³B²z¦n¡A¦ý¥d¦b²Ä¤@Ãö¶}±ÒÀɮתº³¡¤À¡A­ì¦]¬O·í¸ê®Æ§¨¸Ì¦³²Ä¤G­ÓexcelÀÉ¥H¤W®É·|¦P®É¤@°_¶}¤U¥h

¥H¤U¬O©Ò¦³ªºµ{¦¡½X:
Sub A¶}±ÒSPI_TXT()

    Dim lrow As Long
    Dim mFile As String
    Dim Filename As String
   
    If Len(Dir(ThisWorkbook.Path & "\TEST", vbDirectory)) = 0 Then
    MkDir ThisWorkbook.Path & "\TEST"
    End If
   
    mFile = Dir(ThisWorkbook.Path & "\csvÀÉ\" & "*.csv")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\csvÀÉ\" & mFile
    mFile = Dir()
   
    mFile = Dir(ThisWorkbook.Path & "\TXTÀÉ\" & "*.txt")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\TXTÀÉ\" & mFile
    mFile = Dir()
   
    Loop
    Loop
   
    Run "TXT½Æ»s¦ÜCSV"
   
End Sub

Sub TXT½Æ»s¦ÜCSV()

    Workbooks(2).Activate
    Workbooks(2).Worksheets.Add Before:=Sheets(Sheets.Count)
    '¬¡­¶2(CSV)·s¼W¤u§@ªí
   
    For i = 1 To Sheets.Count
    Sheets(i).Name = "Sheet" & i
    Next
   
    Workbooks(3).Activate
    Columns("A:A").Select
    Selection.Copy
    Workbooks(2).Activate
    Sheets("Sheet1").Select
    ActiveSheet.Paste
    '±N¬¡­¶3(TXT)¸ê®Æ½Æ»s¦Ü¬¡­¶2(CSV)
   
    Application.CutCopyMode = False
    Workbooks(3).Close
   
    Run "¥t¦sTESTÀÉ"
   
End Sub
Sub ¥t¦sTESTÀÉ()

    Filename = ActiveWorkbook.Name
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\TEST\" & Filename, _
    FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = True
    Application.WindowState = xlNormal
    '¥t¦sTEST
   
    ActiveWindow.Close SaveChanges:=False
   
End Sub

ªþ¥óÀÉ®×¥i¥H¸Õ¶]¡A¦A³Â·ÐÀ°§Ú¬Ý¬Ý....ÁÂÁÂ

Desktop.zip (20.45 KB)

¸Õ¶]¥¨¶°

TOP

¦^´_ 3# èªÎ¯Ì¦Ï

©Î¬O»¡·í¶}±Ò¬Û¦P¦WºÙ®É¡A¨Ï¥L¤¤Â_°j°é¶i¦æ¤U¤@­ÓRunªº¥¨¶°¡A¤£ª¾¬O§_¥i¦æ??

TOP

¦^´_ 3# èªÎ¯Ì¦Ï


»Ý¨D¦pªþ¥ó¨º¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

TEST.zip (32.33 KB)

TOP

¦^´_ 5# samwang


«D±`©êºp...§Ú¤£¯à¤U¸üªþ¥ó¡AÅv­­¤£¨¬:'( :'(
¥icopy¤å¦rµ¹§Ú¬Ý¶Ü??ÁÂÁ©p~

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2022-4-17 18:22 ½s¿è

¦^´_ 6# èªÎ¯Ì¦Ï


©Ò¦³Àɮשñ¦bfileªº¸ê®Æ§¨¦pªþ¹Ï¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub ¸ü¤J¤å¦rÀÉ()
Dim PH$, FN$, Arr(1 To 2000, 1 To 3), n&, fs, f, fc, T, j%
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set fs = CreateObject("Scripting.FileSystemObject")
If Len(Dir(ThisWorkbook.Path & "\TEST", vbDirectory)) = 0 Then
    MkDir ThisWorkbook.Path & "\TEST"
End If

PH = ThisWorkbook.Path & "\file\"
Do
    If FN = "" Then FN = Dir(PH & "*.txt") Else FN = Dir
    If FN = "" Then Exit Do
    Open PH & "\" & FN For Input As #1
    While Not EOF(1)
        Line Input #1, T
        n = n + 1
        If InStr(T, ",") < 1 Then
            Arr(n, 1) = T
        Else
            TR = Split(T, ",")
            For j = 0 To 2: Arr(n, j + 1) = TR(j): Next
        End If
    Wend
    Close #1
    FN1 = Split(FN, ".")(0)
   
    Set f = fs.GetFolder(PH): Set fc = f.Files
    For Each f1 In fc
        If UCase(Split(f1.Name, ".")(1)) = "CSV" Then
            If Split(f1.Name, ".")(0) = FN1 Then
                With Workbooks.Open(f1.Path)
                    With Sheets(1)
                        R = .Range("a65536").End(3).Row + 1
                        .Range("a" & R).Resize(n, 3) = Arr
                        '¥t¦sTESTÀÉ
                        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\TEST\" & FN1, _
                        FileFormat:=xlCSV, CreateBackup:=False
                        ActiveWindow.Close SaveChanges:=False
                    End With
                End With
            End If
        End If
    Next
    Erase Arr: n = 0
   
Loop
Set f = Nothing: Set fs = Nothing: Set fc = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub
1.JPG
§¹¦¨«áµ²ªG.JPG

TOP

¦^´_ 7# samwang

·|¸õ¥X¦¹°ÝÃD~Àɮפw¦³«ö·Ó¹Ï¤ù1³£©ñ¦bfile¸Ì­±¡C
1.png

next issue

2.png

TOP

¦^´_ 8# èªÎ¯Ì¦Ï

¥i¥H´£¨Ñ§Aªº¸ê®ÆÀÉ®×(¦³¥X²{°ÝÃD)¡A§Ú¨Ó´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

TOP

¦^´_ 9# samwang


¦]­ì©lÀɮ׬OÆZªøªº¡A¦AÀ°§Ú½T»{¬Ý¬Ý¡AÁÂÁÂ
¹Ï¤ù1.jpg
¹Ï¤ù2.jpg

219U30400100306.zip (32.22 KB)

CSV

219U30400100306_TXT.zip (32.27 KB)

TXT

TOP

        ÀR«ä¦Û¦b : ¦¨¥\¬OÀuÂIªºµo´§¡A¥¢±Ñ¬O¯ÊÂIªº²Ö¿n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD