我试图logging一个macros，它试图从文本文件导入数据并将其粘贴到Excel中的特定单元格
我有近30个.txt文件需要被自动导入到excel的相应单元格中。 所以我想出了通过从数据选项卡导入文本录制macros。
要导入到Excel的数据：
Sample.txt ：
123-345-678-91-0
但是，如果数据要导入到Excel中：
Sample1.txt ：
123-345-678-910 345-678-819-000
当Sample.txt返回如上所示的一行输出时，一切正常，但如果返回多个行，如Sample1.txt所示，并且logging一个macros，它将把相应的数据行粘贴到两个连续的行中，而不是一个细胞。 您可以在下面的图片中find有关该问题的信息。
方法尝试：
- 在从文本导入数据之前尝试按F2 。
- 尝试从文本导入前双击相应的单元格。 3.在导入之前按住Alt + Enter 。
PFB图像相同。
手动执行此操作的一种方法是：
- 在记事本中打开文本文件
- select整个文件
- 打开Excel
- select所需的单元格
- 将光标放到公式栏中
-
Paste
您可以logging一个macros来做一些上述（在Excel中的部分）。
也许更有效的方法是，不loggingmacros：
既然你的例子只显示单行，不需要分割成单独的列，我没有考虑到这一点。
- 获取文件path
- 将文本读入一个变体数组，将其分割成
NewLine字符（通常是CHAR（13）） - 使用CHAR（10）作为分隔符（vbLF），这是Excel用于将东西放在单个单元格中的新行的分隔文本到数组。
- 写到所需的单元格。
- 调整列宽和高度以适合。
这是做这个的一个方法。 它需要设置对Microsoft Scripting Runtime的引用，以便能够使用FileSystemObject 。 FileSystemObject在MSDN Library 中的FileSystemObject对象的VBA引用开始描述：
Option Explicit 'Set Refereence to Microsoft Scripting Runtime Sub ImportTextFileToOneCell() Dim vFileName As Variant Dim WS As Worksheet, R As Range Dim FSO As FileSystemObject, TS As TextStream Dim V As Variant Set WS = Worksheets("sheet1") Set R = WS.Cells(1, 1) vFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt") If vFileName = False Then Exit Sub Set FSO = New FileSystemObject Set TS = FSO.OpenTextFile(vFileName, ForReading) V = Split(TS.ReadAll, vbNewLine) V = Join(V, vbLf) R = V With R .ColumnWidth = 255 .EntireRow.AutoFit .EntireColumn.AutoFit End With End Sub
把文本放在双引号之间
“123-345-678-910 345-678-819-000"
并将文件扩展名更改为.csv 。
请试试这个：
txtfile = "Text File Path Here" excelfile = "Excel File Path Here" ExcelSheetName = "Sheet1" ExcelRowToInsert = 1 ExcelColumnToInsert = 1 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objExcel = CreateObject("Excel.Application") Set tf = objFSO.OpenTextFile(txtfile, 1) Set book = objExcel.Workbooks.Open(excelfile) Do Until tf.AtEndOfStream book.Sheets(ExcelSheetName).Cells(ExcelRowToInsert,ExcelColumnToInsert).Value = tf.ReadLine ExcelRowToInsert = ExcelRowToInsert + 1 Loop tf.Close book.Close True objExcel.Quit MsgBox "Task Completed", vbOKOnly, "Text to Excel"
像这样的东西
Function ReadAllText(sFileName As String) As String Dim iFileNumber As Integer iFileNumber = FreeFile Open sFileName For Input As #iFileNumber ReadAllText = Input$(LOF(iFileNumber), iFileNumber) Close #iFileNumber End Function Sub Main() [A1] = Replace(ReadAllText("C:\Sample1.txt"), vbCr, "") [A2] = Replace(ReadAllText("C:\Sample2.txt"), vbCr, "") End Sub