非常简单的VBA从分隔文件复制/粘贴错误地将所有列合并为一列

我有多个文件（fanspeedA、fanspeedB…）没有任何文件扩展名，并且是管道分隔的（或“|”）文件。缺少文件扩展名是否会导致VBA在复制粘贴期间无法理解分隔列

下面是我正在使用的VBA代码，它执行以下步骤：

1） 定义变量，存储从中调用此宏的工作表

2） 打开对话框以选择文件

3） 根据文件选择启动循环，使用管道分隔符“|”打开每个文件

• 所有文件都正确打开，并正确分隔，所有列都已识别

4） 打开临时文件时，复制使用范围并关闭文件

5） 打开原始工作簿，基于临时文件名创建新工作表，将单元格粘贴到此工作表中

• 此时手动复制/粘贴将保留列，但在VBA中执行此步骤会将所有列合并到第一列中

---

---

尽可能避免使用select。 例如，替换

ActiveSheet.UsedRange.Select
选择，复制

与

更好的做法是，将所有数据放入一个数组（特别是如果您想对其执行任何操作），然后将该数组打印到第二张图纸上

'/ Determine 1st/last row/column of the data
dim arrData as variant
    arrData = Array()
    ReDim arrData(bounds of the data range)
    arrData = RngCopy (from above)

new sheet:

set rngPaste = '/(Size of Array)
    rngpaste = arrData

---

对于使用数组存储（可能操作）和传输值：

Sub PasteUsingArray()

Dim rngCopy As Range
    rngCopy = ActiveSheet.UsedRange

    Dim LB1 As Long '/ Lower Bound of the 1st dimension (rows)
    Dim UB1 As Long
    Dim LB2 As Long
    Dim UB2 As Long

        LB1 = 1
        LB2 = 1 '/ Standard for arrays unless you specify otherwise

        UB1 = rngCopy.Rows.Count
        UB2 = rngCopy.Columns.Count '/ We now have the size of our data

        Dim arrData As Variant
            arrData = Array()

            ReDim arrData(LB1 To UB1, LB2 To UB2) '/ Now our array is the sime size as our data
            arrData = rngCopy '/ Voila, our array now contains all the data. What was in Cell(1,1) is now in arrData(1,1) [Asuming the data starts in cells(1,1)]

            '/ To print this data to a second sheet, we do this process in reverse.

        Dim rngPaste As Range

        Set rngPaste = Range(Cells(LB1, LB2), Cells(UB1, UB2))

        rngPaste = arrData

End Sub

---

只要数组变量仍在引用中，您可以在粘贴数据之前或之后对数据进行处理。

结合此处所述内容和我在internet上找到的内容：

最后的代码将打开一个提示，选择一个文件范围，打开每个文件，根据分隔符“|”进行分隔，将每个文件中使用范围的值作为新工作表保存到原始工作簿中，关闭打开的文件。它肯定不是最有效的，但是它不再使用select和activesheet

Sub loopyarray()

Dim filenames As Variant

' get current workbook name to cut/paste opened sheets into
Dim strBookName As Workbook, tmpBookName As String
Set strBookName = ThisWorkbook
Dim str() As String

Dim myRow As Long
Dim myCol As Long

' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)

   counter = 1

   ' ubound determines how many items in the array
   While counter <= UBound(filenames)

      ' Opens the selected files
      Workbooks.OpenText filenames(counter), 437, 1, xlDelimited, xlTextQualifierDoubleQuote, 0, 0, 0, 0, 0, 1, "|"

      ' Copy From Temporary Book
      tmpBookName = ActiveSheet.Name ' save temporary sheet name
      Dim rngCopy As Range
      Set rngCopy = ActiveSheet.UsedRange
      Dim inputArray As Variant
      inputArray = rngCopy.Value ' convert used range to array
      ActiveWorkbook.Close

      ' Paste to Original Book
      Windows(strBookName.Name).Activate 'activate original book
      Worksheets.Add(Before:=Worksheets(1)).Name = tmpBookName 'new sheet based on temp sheet name
      For myCol = 1 To UBound(inputArray, 2)
        For myRow = 1 To UBound(inputArray, 1)
            Cells(myRow, myCol).Value = inputArray(myRow, myCol)
        Next
      Next

      ' increment counter
      counter = counter + 1

   Wend
End Sub

Sub-loopyarray（）
变暗文件名作为变量
'获取当前工作簿名称以将打开的工作表剪切/粘贴到其中
Dim strBookName作为工作簿，tmpBookName作为字符串
设置strBookName=此工作簿
Dim str（）作为字符串
让我的行变长
暗霉
'将数组设置为一个变量，对于multi-select，为True
filenames=Application.GetOpenFilename（，，True）
计数器=1
'ubound确定数组中有多少项
而计数器尝试在每行上使用split（）函数。然后循环由拆分填充的数组，并将每个数组槽中的值放入一列中。我同意MatthewD的观点，在这一列中使用
split（）
函数应该非常有效。如果您正在处理大型进口，您甚至可能想考虑改变这种方法以使其更快。如果我不能让OpenText方法很好地与copy/paste一起工作，我将研究split方法。基本上，我只是（1）将文本文件加载到数组中，（2）根据分隔符拆分每一行，（3）将拆分的输出保存到新数组中，（4）将新工作表单元格值设置为拆分数组？我试图实现您的前半部分响应，但在行单元格中出现错误：“object不支持此属性或方法”(1,1).paste这没有帮助。错误是什么？代码中的哪里发生了错误？此外，良好的做法是，如果您更改了代码，请在问题中添加一个显示新代码的编辑。在我的原始帖子中更新了我的代码以反映所发生的情况。复制部分似乎工作正常。粘贴部分不工作。此外，我希望使用工具为了提高速度，您在下半部分描述了基于数组的粘贴方法，但我不太确定如何使用.pastery.pasteValuesi将添加一个单独的答案，详细说明数组方法
'/ Determine 1st/last row/column of the data
dim arrData as variant
    arrData = Array()
    ReDim arrData(bounds of the data range)
    arrData = RngCopy (from above)

new sheet:

set rngPaste = '/(Size of Array)
    rngpaste = arrData

Sub PasteUsingArray()

Dim rngCopy As Range
    rngCopy = ActiveSheet.UsedRange

    Dim LB1 As Long '/ Lower Bound of the 1st dimension (rows)
    Dim UB1 As Long
    Dim LB2 As Long
    Dim UB2 As Long

        LB1 = 1
        LB2 = 1 '/ Standard for arrays unless you specify otherwise

        UB1 = rngCopy.Rows.Count
        UB2 = rngCopy.Columns.Count '/ We now have the size of our data

        Dim arrData As Variant
            arrData = Array()

            ReDim arrData(LB1 To UB1, LB2 To UB2) '/ Now our array is the sime size as our data
            arrData = rngCopy '/ Voila, our array now contains all the data. What was in Cell(1,1) is now in arrData(1,1) [Asuming the data starts in cells(1,1)]

            '/ To print this data to a second sheet, we do this process in reverse.

        Dim rngPaste As Range

        Set rngPaste = Range(Cells(LB1, LB2), Cells(UB1, UB2))

        rngPaste = arrData

End Sub

Sub loopyarray()

Dim filenames As Variant

' get current workbook name to cut/paste opened sheets into
Dim strBookName As Workbook, tmpBookName As String
Set strBookName = ThisWorkbook
Dim str() As String

Dim myRow As Long
Dim myCol As Long

' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)

   counter = 1

   ' ubound determines how many items in the array
   While counter <= UBound(filenames)

      ' Opens the selected files
      Workbooks.OpenText filenames(counter), 437, 1, xlDelimited, xlTextQualifierDoubleQuote, 0, 0, 0, 0, 0, 1, "|"

      ' Copy From Temporary Book
      tmpBookName = ActiveSheet.Name ' save temporary sheet name
      Dim rngCopy As Range
      Set rngCopy = ActiveSheet.UsedRange
      Dim inputArray As Variant
      inputArray = rngCopy.Value ' convert used range to array
      ActiveWorkbook.Close

      ' Paste to Original Book
      Windows(strBookName.Name).Activate 'activate original book
      Worksheets.Add(Before:=Worksheets(1)).Name = tmpBookName 'new sheet based on temp sheet name
      For myCol = 1 To UBound(inputArray, 2)
        For myRow = 1 To UBound(inputArray, 1)
            Cells(myRow, myCol).Value = inputArray(myRow, myCol)
        Next
      Next

      ' increment counter
      counter = counter + 1

   Wend
End Sub