Ar mhaith leat an spás (teorainneacha) a choinneáil tar éis duit na comhaid téacs a thiontú go leatháin?

An bhféadfá an téacschomhad agus an toradh atá uait dom a uaslódáil?

Dia duit, Des agus PB Rama Murty, is féidir leis an gcód thíos sonraí a roinnt i gcolúin bunaithe ar spás nó cluaisín agus comhad téacs á iompórtáil go bileoga. Is féidir leat triail a bhaint as.

Fo-IompórtáilTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb Mar Leabhar Oibre
Dim xToBook Mar Leabhar Oibre
Dim xStrPath Mar Teaghrán
Dim xFileDialog Mar FileDialog
Dim xFile Mar Teaghrán
Dim xFiles Mar Bhailiúchán Nua
Dim I Chomh Fada
Dim xIntRow Chomh fada
Dim xFNum, xFArr Chomh fada
Dim xStrValue As Teaghrán
Dim xRg Mar Raon
Dim xArr
Socraigh xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect=Bréagach
xFileDialog.Title = "Roghnaigh fillteán [Kutools le haghaidh Excel]"
Má tá xFileDialog.Show = -1 Ansin
xStrPath = xFileDialog.SelectedItems(1)
Deireadh Má
Má tá xStrPath="" Ansin Scoir Fo
Más Ceart(xStrPath, 1) <> "\" Ansin xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Má tá xFile="" Ansin
MsgBox "Níor aimsíodh comhaid", vbInformation, "Kutools for Excel"
Fo-Scoir
Deireadh Má
Déan Cé go bhfuil xFile <>"""
xFiles.Cuir xFile, xFile
xFile = Dir()
Lúb
Socraigh xToBook = An Leabhar Oibre Seo
Ar Lean Earráid Aghaidh
Application.ScreenUpdating = Bréagach
Má tá xFiles.Count > 0 Ansin

Do I = 1 Go xFiles.Count
Socraigh xWb = Leabhair Oibre.Open(xStrPath & xFiles.Item(I))
xWb.Bileoga Oibre(1). Cóipeáil i ndiaidh:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Dún Bréagach
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Le haghaidh xFNum = 1 Go xIntRow
Socraigh xRg = ActiveSheet.Range("A" & xFNum)
xArr = Scoilt(xRg.Text, "")
Má tá UBound(xArr) > 0 Ansin
Le haghaidh xFArr = 0 Go UBound(xArr)
Má tá xArr(xFArr) <> "" Ansin
xRg.Value = xArr(xFArr)
Socraigh xRg = xRg.Offset(ColumnOffset:=1)
Deireadh Má
Ar Aghaidh
Deireadh Má
Ar Aghaidh
Ar Aghaidh
Deireadh Má
Feidhmchlár.ScreenUpdating = Fíor
Fo Deireadh

Cad iad na hathruithe is gá a dhéanamh má theastaíonn uaim sonraí a chur isteach i gcolúin bunaithe ar chamóg?

D'úsáid mé é seo agus oibríonn sé ach ba mhaith liom é a shábháil ar bhileog amháin mar gurb é an t-eolas céanna atá ar gach bileog agus níl iontu ach comhaid logála ó gach lá.
mar sin ní mór dom an
gach mír san fhillteán ar bhileog amháin
Fo-IompórtáilCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xWb Mar Leabhar Oibre
Dim xToBook Mar Leabhar Oibre
Dim xStrPath Mar Teaghrán
Dim xFileDialog Mar FileDialog
Dim xFile Mar Teaghrán
Dim xFiles Mar Bhailiúchán Nua
Dim I Chomh Fada
Dim xIntRow Chomh fada
Dim xFNum, xFArr Chomh fada
Dim xStrValue As Teaghrán
Dim xRg Mar Raon
Dim xArr
Ar Earráid TéighTo ErrHandler
Socraigh xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect=Bréagach
xFileDialog.Title = "Roghnaigh fillteán [Kutools le haghaidh Excel]"
Má tá xFileDialog.Show = -1 Ansin
xStrPath = xFileDialog.SelectedItems(1)
Deireadh Má
Má tá xStrPath="" Ansin Scoir Fo
Más Ceart(xStrPath, 1) <> "\" Ansin xStrPath = xStrPath & "\"
Socraigh xSht = ThisWorkbook.ActiveSheet
If MsgBox("Glan an leathán reatha roimh iompórtáil?", vbYesNo, "Kutools for Excel") = vbYes Ansin xSht.UsedRange.Clear
Application.ScreenUpdating = Bréagach
xFile = Dir(xStrPath & "\" & "*.log")
Déan Cé go bhfuil xFile <>"""
Socraigh xWb = Leabhair Oibre.Open(xStrPath & "\" &xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).Deireadh(xlUp).Fritháireamh(1)
xWb.Dún Bréagach
xFile = Dir
Lúb
Feidhmchlár.ScreenUpdating = Fíor
Fo-Scoir
Earráid:
MsgBox "gan comhaid txt", , "Kutools le haghaidh Excel"
Fo Deireadh

agus an ceann seo a úsáideann spásanna go dd do gach colún

Fo-IompórtáilTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb Mar Leabhar Oibre
Dim xToBook Mar Leabhar Oibre
Dim xStrPath Mar Teaghrán
Dim xFileDialog Mar FileDialog
Dim xFile Mar Teaghrán
Dim xFiles Mar Bhailiúchán Nua
Dim I Chomh Fada
Dim xIntRow Chomh fada
Dim xFNum, xFArr Chomh fada
Dim xStrValue As Teaghrán
Dim xRg Mar Raon
Dim xArr
Socraigh xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect=Bréagach
xFileDialog.Title = "Roghnaigh fillteán [Kutools le haghaidh Excel]"
Má tá xFileDialog.Show = -1 Ansin
xStrPath = xFileDialog.SelectedItems(1)
Deireadh Má
Má tá xStrPath="" Ansin Scoir Fo
Más Ceart(xStrPath, 1) <> "\" Ansin xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Má tá xFile="" Ansin
MsgBox "Níor aimsíodh comhaid", vbInformation, "Kutools for Excel"
Fo-Scoir
Deireadh Má
Déan Cé go bhfuil xFile <>"""
xFiles.Cuir xFile, xFile
xFile = Dir()
Lúb
Socraigh xToBook = An Leabhar Oibre Seo
Ar Lean Earráid Aghaidh
Application.ScreenUpdating = Bréagach
Má tá xFiles.Count > 0 Ansin

Do I = 1 Go xFiles.Count
Socraigh xWb = Leabhair Oibre.Open(xStrPath & xFiles.Item(I))
xWb.Bileoga Oibre(1). Cóipeáil i ndiaidh:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Dún Bréagach
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Le haghaidh xFNum = 1 Go xIntRow
Socraigh xRg = ActiveSheet.Range("A" & xFNum)
xArr = Scoilt(xRg.Text, "")
Má tá UBound(xArr) > 0 Ansin
Le haghaidh xFArr = 0 Go UBound(xArr)
Má tá xArr(xFArr) <> "" Ansin
xRg.Value = xArr(xFArr)
Socraigh xRg = xRg.Offset(ColumnOffset:=1)
Deireadh Má
Ar Aghaidh
Deireadh Má
Ar Aghaidh
Ar Aghaidh
Deireadh Má
Feidhmchlár.ScreenUpdating = Fíor
Fo Deireadh

Is féidir leat Find and Replace fuctuon a úsáid chun spás a chur in ionad an chamóg ar dtús, agus an modh thuas a chur i bhfeidhm chun é a thiontú go comhad Excel.

An bhfuil sé i gceist agat gach comhad téacs a chomhcheangal le leathán amháin?

Dia duit, Davinder, is féidir leat triail thíos cód 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

D'oibrigh an cód seo domsa ach fós féin, ní mór dom roinnt a athrú ann.

*Ba mhaith liom é a ghreamú ar an mbileog chéanna gan leathanach nua a oscailt agus ansin é a chóipeáil mar go dtógann sé níos mó ama.

*ní mór coinníoll a chur isteach má tá comhaid txt iompórtáilte le greamú ar bhileog 1 má thosaíonn sé le litir A agus má iompórtáladh go Bileog 2 iad má thosaíonn sé le litir B


Fo-chóip 3()
Dim xWb Mar Leabhar Oibre
Dim xToBook Mar Leabhar Oibre
Dim xStrPath Mar Teaghrán
Dim xFileDialog Mar FileDialog
Dim xFile Mar Teaghrán
Dim xFiles Mar Bhailiúchán Nua
Dim i Chomh fada
Dim LastRow Chomh fada
Dim Rng Mar Raon
Socraigh xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect=Bréagach
xFileDialog.Title = "Roghnaigh fillteán [Kutools le haghaidh Excel]"
Má tá xFileDialog.Show = -1 Ansin
xStrPath = xFileDialog.SelectedItems(1)
Deireadh Má
Má tá xStrPath="" Ansin Scoir Fo
Más Ceart(xStrPath, 1) <> "\" Ansin xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Má tá xFile="" Ansin
MsgBox "Níor aimsíodh comhaid", vbInformation, "Kutools for Excel"
Fo-Scoir
Deireadh Má
Déan Cé go bhfuil xFile <>"""
xFiles.Cuir xFile, xFile
xFile = Dir()
Lúb
Raon ("N2").Roghnaigh
Socraigh xToBook = An Leabhar Oibre Seo
Má tá xFiles.Count > 0 Ansin
Le haghaidh i = 1 Go xFiles.Count
Socraigh xWb = Leabhair Oibre.Open(xStrPath & xFiles.Item(i))
xWb.Gníomhachtaigh
'Na sonraí txt a roghnú agus a chóipeáil
Raon (Roghnú, Roghnú.End(xlDown)).Roghnaigh
Roghnú.Cóip
xToBook.Gníomhach
ActiveSheet.Greamaigh
Selection.End(xlDown).Fritháireamh(1).Roghnaigh
Ar Lean Earráid Aghaidh
Ar Earráid TéighTo 0
xWb.Dún Bréagach
Ar Aghaidh
Deireadh Má
Fo Deireadh

Tá brón orm, tá mo lámha ceangailte

Ár leithscéal, a Harsh, bí cúramach gan allmhairiú arís agus arís eile.

Mar sin féin, is féidir leat triail a bhaint as feidhm Bain Leading Zeros de Kutools le haghaidh Excel chun gach nialais tosaigh a bhaint as an roghnú tar éis allmhairithe.

Más mian leat na nialais tosaigh a choinneáil, is féidir leat iad a fhormáidiú mar fhormáid téacs de réir Formáid Cell.

Dia duit, bain triail as an gcód thíos

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

Dia duit, Daniel, bain triail as an gcód thíos, iompórtálann sé gach comhad téacs i mbileog amháin darb ainm txt.
Tabhair faoi deara: má tá an t-ainm téacs mar an gcéanna leis an ainm bileoige atá ann cheana féin, ní féidir an comhad téacs a allmhairiú.

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