Удаление дополнительных каналов в коде Visual Basic для макроса файла Excel

Question

Я создал файл Excel, в котором есть макрос, который выполняет несколько задач.На изображении вы можете увидеть, как выглядит файл Excel.Пользователь введет свои данные в строки 12 и 13. Макрос запустится, и он создаст файл блокнота, который использует разделители каналов.Как вы видите, он создает дополнительные каналы в первой строке текста - это то, от чего я пытаюсь избавиться.

    Sub NewPipeFile()

    Dim IntialName As String
    Dim sFileSaveName As Variant
    IntialName = "Sample Output"
    sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

    If sFileSaveName <> False Then
        ActiveWorkbook.SaveAs sFileSaveName
    End If

    'Deletes instructions
    Rows("1:11").Select
    Range("A11").Activate
    Selection.Delete Shift:=xlUp

    'Deletes bottom 85 rows so end up with no blank lines
    Rows("14:14").Select
    ActiveWindow.SmallScroll Down:=90
    Rows("14:100").Select
    Selection.Delete Shift:=xlUp

    'Deletes comments, makes text black, etc
    Selection.Font.Bold = False
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.ClearComments



Const myDelim As String = "|"
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Long, c As Long, i As Long, j As Long
r = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
c = ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim myPath As String
myPath = ThisWorkbook.Path & "\"
Dim myFile As String
myFile = myPath & Format(Now(), "yyyy-mm-dd--hh-mm-ss") & "PipeFile.txt"
Dim obj As Object
Set obj = CreateObject("ADODB.Stream")
obj.Type = 2
obj.Charset = "unicode"
obj.Open
Dim v() As Variant
ReDim v(1 To c)
For i = 1 To r
For j = 1 To c
v(j) = ws.Cells(i, j).Text
Next
obj.WriteText Join(v, myDelim), 1
Next
obj.SaveToFile myFile, 2
Dim Npad
Npad = Shell("C:\WINDOWS\notepad.exe " & myFile, 1)
End Sub

Answer 1

Цикл, подобный следующему:

For i = 1 To r
  c = ws.Cells(r,ws.columns.count).end(xlToLeft).column
  Dim v as Variant
  v = ws.Range(ws.Cells(r,1),ws.Cells(r,c)).Value
  objWriteText Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(v)), myDelim), 1
Next

Я использую здесь транспонирование, поскольку в списке столбцов относительно мало столбцов (поэтому это не повлияет на скорость).Я использую его дважды, потому что он основан на столбцах.Итак, первая транспонирование - получить строку на основе, а 2-е - сделать 1D, поскольку диапазон по умолчанию равен 2D массивам.