Это правильный способ объединения VBA в один?

Question

Я пытаюсь экспортировать 4 столбца в один файл .csv. Поэтому я хочу объединить все 4 столбца в один диапазон и экспортировать этот диапазон. Так или иначе, у rng есть только один столбец. Почему?

Set rng = Application.Union(Range("Berechnung!$A$10811:$A$39611"),Range("Berechnung!$BA$10811:$BC$39611"))

Спасибо!

Answer 1

Вы используете UNION в порядке, но теперь вы должны учитывать тот факт, что диапазон имеет более одной области.

В этом ответе используется ВАШ код и он расширяется для работы с областями в несвязанном диапазоне .

Set rng = Union(Range("Berechnung!$A$10811:$A$39611"),Range("Berechnung!$BA$10811:$BC$39611"))

For i = 1 To rng.Rows.Count
    For a = 1 To rng.Areas.Count
        For j = 1 To rng.Areas(a).Columns.Count
            str = str & rng.Areas(a)(i, j).Value & " ,"
        Next
    Next
    Print #fNum, Left(str, Len(str) - 2)
    str = ""
Next

Answer 2

У вас есть непересекающийся диапазон. В этом случае подсчитать количество столбцов непросто. Например:

Sub dural()
    Dim r1 As Range, r2 As Range, rTot As Range, Column As Variant
    Dim kount As Long
    Set r1 = Range("A1:A10")
    Set r2 = Range("D1:E10")
    Set rTot = Union(r1, r2)

    MsgBox rTot.Columns.Count

    kount = 0
    For Each Column In rTot.Columns
        kount = kount + 1
    Next Column

    MsgBox kount
End Sub

Первый MsgBox сообщит 1 , второй MsgBox сообщит 3 .

Answer 3

Вы можете использовать процедуру, которая создает массив и преобразует его в csv в качестве параметра.

Sub ExportSheetsToCSV()

    Dim Ws As Worksheet
    Dim xcsvFile As String
    Dim vDB1 As Variant, vDB2 As Variant, vDB() As Variant
    Dim r As Long, i As Long, j As Integer
    Set Ws = ActiveSheet

    xcsvFile = CurDir & "\" & Ws.Name & ".csv"


    vDB1 = Range("Berechnung!$A$10811:$A$39611")
    vDB2 = Range("Berechnung!$BA$10811:$BC$39611")


    r = UBound(vDB1, 1)
    ReDim vDB(1 To r, 1 To 4)
    For i = 1 To r
        vDB(i, 1) = vDB1(i, 1)
        For j = 1 To 3
            vDB(i, j + 1) = vDB2(i, j)
        Next j
    Next i
    TransToCSV xcsvFile, vDB
    MsgBox ("Files Saved Successfully")
End Sub

Sub TransToCSV(myfile As String, vDB As Variant)

    Dim vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")

    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
         .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Answer 4

Option Explicit
Sub MyExportCsv()

    Const START_ROW = 10811
    Const END_ROW = 39611
    Const CSV_FILE = "export.csv"

    Dim ws As Worksheet, str As String, i As Long
    Dim rng As Range, cell As Range, count As Long

    Dim oFSO As Object, oFS As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFS = oFSO.CreateTextFile(CSV_FILE)

    Set ws = ThisWorkbook.Sheets("Sheet1")

    For i = START_ROW To END_ROW

        str = ws.Range("A" & i)
        Set rng = ws.Range("BA" & i & ":BC" & i)
        For Each cell In rng
           str = str & " ," & cell.Value
        Next
        oFS.writeline str
        count = count + 1

    Next
    oFS.Close

    MsgBox count & " records written to " & CSV_FILE, vbInformation, "Finished"

End Sub