텍스트 파일을 시트로 변환한 후 공백(구분자)을 유지하시겠습니까?

텍스트 파일과 원하는 결과를 업로드할 수 있습니까?

안녕하세요, Des 및 PB Rama Murty, 아래 코드는 텍스트 파일을 시트로 가져오는 동안 공간 또는 탭을 기반으로 데이터를 열로 분할할 수 있습니다. 시도해 볼 수 있습니다.

하위 ImportTextToExcel()
'업데이트바이Extendoffice20180911
Dim xWb를 통합 문서로
Dim xToBook을 통합 문서로
Dim xStrPath를 문자열로
Dim xFileDialog As FileDialog
Dim xFile을 문자열로
xFiles를 새 컬렉션으로 흐리게 처리
흐릿한 I As Long
Dim xIntRow As Long
희미한 xFNum, xFArr As Long
Dim xStrValue를 문자열로
범위로 Dim xRg
희미한 xArr
xFileDialog 설정 = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 거짓
xFileDialog.Title = "[Kutools for Excel] 폴더 선택"
xFileDialog.Show = -1이면
xStrPath = xFileDialog.SelectedItems(1)
END IF
xStrPath = ""이면 Sub 종료
If Right(xStrPath, 1) <> "\" 그러면 xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
xFile = ""이면
MsgBox "파일을 찾을 수 없습니다", vbInformation, "Excel용 Kutools"
서브 종료
END IF
Do While xFile <> ""
xFiles.xFile, xFile 추가
xFile = 디렉터리()
고리
xToBook = ThisWorkbook 설정
오류에 대한 다음 재개
Application.ScreenUpdating = False
xFiles.Count > 0이면

I = 1 xFiles.Count에 대해
xWb 설정 = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).다음 이후 복사:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.닫기 거짓
xIntRow = ActiveCell.CurrentRegion.Rows.Count
xFNum의 경우 = 1에서 xIntRow까지
xRg = ActiveSheet.Range("A" & xFNum) 설정
xArr = 분할(xRg.Text, " ")
UBound(xArr) > 0이면
xFArr = 0 UBound(xArr)까지
xArr(xFArr) <> ""이면
xRg.값 = xArr(xFArr)
xRg = xRg.Offset(ColumnOffset:=1) 설정
END IF
다음
END IF
다음
다음
END IF
Application.ScreenUpdating = True
최종 하위

데이터를 쉼표를 기반으로 하는 열로 변환해야 하는 경우 어떤 변경을 수행해야 합니까?

나는 이것을 사용했고 작동하지만 각 시트는 매일 로그 파일과 동일한 정보이므로 모두 하나의 시트에 저장하고 싶습니다.
그래서 나는
폴더의 모든 항목을 하나의 시트로
하위 ImportCSVsWithReference()
'Excel20151214용 Kutools로 업데이트
Dim xWb를 통합 문서로
Dim xToBook을 통합 문서로
Dim xStrPath를 문자열로
Dim xFileDialog As FileDialog
Dim xFile을 문자열로
xFiles를 새 컬렉션으로 흐리게 처리
흐릿한 I As Long
Dim xIntRow As Long
희미한 xFNum, xFArr As Long
Dim xStrValue를 문자열로
범위로 Dim xRg
희미한 xArr
오류 시 이동 ErrHandler
xFileDialog 설정 = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 거짓
xFileDialog.Title = "[Kutools for Excel] 폴더 선택"
xFileDialog.Show = -1이면
xStrPath = xFileDialog.SelectedItems(1)
END IF
xStrPath = ""이면 Sub 종료
If Right(xStrPath, 1) <> "\" 그러면 xStrPath = xStrPath & "\"
xSht = ThisWorkbook.ActiveSheet 설정
If MsgBox("가져오기 전에 기존 시트를 지우시겠습니까?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
Do While xFile <> ""
xWb 설정 = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.닫기 거짓
xFile = 디렉토리
고리
Application.ScreenUpdating = True
서브 종료
오류 핸들러:
MsgBox "txt 파일 없음", "Excel용 Kutools"
최종 하위

이것은 각 열에 dd를 추가하는 공백입니다.

하위 ImportTextToExcel()
'업데이트바이Extendoffice20180911
Dim xWb를 통합 문서로
Dim xToBook을 통합 문서로
Dim xStrPath를 문자열로
Dim xFileDialog As FileDialog
Dim xFile을 문자열로
xFiles를 새 컬렉션으로 흐리게 처리
흐릿한 I As Long
Dim xIntRow As Long
희미한 xFNum, xFArr As Long
Dim xStrValue를 문자열로
범위로 Dim xRg
희미한 xArr
xFileDialog 설정 = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 거짓
xFileDialog.Title = "[Kutools for Excel] 폴더 선택"
xFileDialog.Show = -1이면
xStrPath = xFileDialog.SelectedItems(1)
END IF
xStrPath = ""이면 Sub 종료
If Right(xStrPath, 1) <> "\" 그러면 xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
xFile = ""이면
MsgBox "파일을 찾을 수 없습니다", vbInformation, "Excel용 Kutools"
서브 종료
END IF
Do While xFile <> ""
xFiles.xFile, xFile 추가
xFile = 디렉터리()
고리
xToBook = ThisWorkbook 설정
오류에 대한 다음 재개
Application.ScreenUpdating = False
xFiles.Count > 0이면

I = 1 xFiles.Count에 대해
xWb 설정 = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).다음 이후 복사:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.닫기 거짓
xIntRow = ActiveCell.CurrentRegion.Rows.Count
xFNum의 경우 = 1에서 xIntRow까지
xRg = ActiveSheet.Range("A" & xFNum) 설정
xArr = 분할(xRg.Text, " ")
UBound(xArr) > 0이면
xFArr = 0 UBound(xArr)까지
xArr(xFArr) <> ""이면
xRg.값 = xArr(xFArr)
xRg = xRg.Offset(ColumnOffset:=1) 설정
END IF
다음
END IF
다음
다음
END IF
Application.ScreenUpdating = True
최종 하위

찾기 및 바꾸기 기능을 사용하여 쉼표를 먼저 공백으로 바꾸고 위의 방법 중 하나를 적용하여 Excel 파일로 변환할 수 있습니다.

모든 텍스트 파일을 하나의 시트로 결합하는 것을 의미합니까?

안녕하세요, Davinder, vba 코드 아래에서 시도해 볼 수 있습니다.

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub

이 코드가 저에게 효과적이었지만 여전히 일부를 변경해야 합니다.

*새 시트를 열지 않고 같은 시트에 붙여넣고 시간이 오래 걸리므로 복사하고 싶습니다.

* 가져온 txt 파일이 문자 A로 시작하는 경우 시트 1에 붙여넣고 문자 B로 시작하는 경우 시트 2로 가져온 경우 조건문을 삽입해야 합니다.


하위 testcopy3()
Dim xWb를 통합 문서로
Dim xToBook을 통합 문서로
Dim xStrPath를 문자열로
Dim xFileDialog As FileDialog
Dim xFile을 문자열로
xFiles를 새 컬렉션으로 흐리게 처리
오랫동안 어둡게
마지막 행을 길게 흐리게
범위로 딤 Rng
xFileDialog 설정 = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 거짓
xFileDialog.Title = "[Kutools for Excel] 폴더 선택"
xFileDialog.Show = -1이면
xStrPath = xFileDialog.SelectedItems(1)
END IF
xStrPath = ""이면 Sub 종료
If Right(xStrPath, 1) <> "\" 그러면 xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
xFile = ""이면
MsgBox "파일을 찾을 수 없습니다", vbInformation, "Excel용 Kutools"
서브 종료
END IF
Do While xFile <> ""
xFiles.xFile, xFile 추가
xFile = 디렉터리()
고리
범위("N2").선택
xToBook = ThisWorkbook 설정
xFiles.Count > 0이면
i = 1 xFiles.Count까지
xWb 설정 = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.활성화
'txt 데이터 선택 및 복사
범위 (Selection, Selection.End (xlDown)). 선택
선택. 복사
xToBook.활성화
ActiveSheet.Paste
선택.종료(xlDown).오프셋(1).선택
오류에 대한 다음 재개
오류 발생시 0
xWb.닫기 거짓
다음
END IF
최종 하위

미안, 내 손이 묶여

죄송합니다. 가혹한, 반복적으로 가져오지 않도록 주의하십시오.

Pooja, Excel 용 Kutools의 선행 XNUMX 제거 기능을 시도하여 가져온 후 선택 항목에서 모든 선행 XNUMX을 제거 할 수 있습니다.

선행 XNUMX을 유지하려면 셀 형식을 사용하여 텍스트 형식으로 서식을 지정할 수 있습니다.

안녕하세요, 아래 코드를 시도하십시오

Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

안녕하세요, Daniel, 아래 코드를 사용해 보세요. Txt라는 시트 하나에 모든 텍스트 파일을 가져옵니다.
참고: 텍스트 이름이 기존 시트 이름과 동일한 경우 텍스트 파일을 가져오지 못할 수 있습니다.

Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub