excel - 将选定的行和列导出到 CSV 文件

Question

我希望能够使用 VBA 将选定的单元格范围导出到 .csv 文件。到目前为止，我所想出的方法在凝聚选择方面表现出色，但在选择多列时却惨遭失败。

这是我从互联网上找到的片段中设法组合而成的代码:它还摆弄了一些 UI，因为我的 Excel 讲德语，所以我需要有“.”。作为小数点分隔符而不是“，”它对此进行了调整。

Sub Range_Nach_CSV_()
Dim vntFileName As Variant
Dim lngFN As Long
Dim rngRow As Excel.Range
Dim rngCell As Excel.Range
Dim strDelimiter As String
Dim strText As String
Dim strTextCell As String
Dim strTextCelll As String
Dim bolErsteSpalte As Boolean
Dim rngColumn As Excel.Range
Dim wksQuelle As Excel.Worksheet
Dim continue As Boolean

strDelimiter = vbtab

continue = True

Do While continue = True

vntFileName = Application.GetSaveAsFilename("Test.txt", _
    FileFilter:="TXT-File (*.TXT),*.txt")
If vntFileName = False Then
    Exit Sub
End If

If Len(Dir(vntFileName)) > 0 Then
    Dim ans As Integer
    ans = MsgBox("Datei existiert bereits. Überschreiben?", vbYesNo)
    If ans = vbYes Then
        continue = False
    ElseIf ans = vbNo Then
        continue = True
    Else
        continue = False
    End If
Else
    continue = False
End If

Loop

Set wksQuelle = ActiveSheet

lngFN = FreeFile
Open vntFileName For Output As lngFN

    For Each rngRow In Selection.Rows
        strText = ""
        bolErsteSpalte = True

        For Each rngCell In rngRow.Columns
            strTextCelll = rngCell.Text
            strTextCell = Replace(strTextCelll, ",", ".")
            If bolErsteSpalte Then
                strText = strTextCell
                bolErsteSpalte = False
            Else
                strText = strText & strDelimiter & strTextCell
            End If
        Next

    Print #lngFN, strText

    Next
Close lngFN

End Sub

正如我已经提到的，该子程序可以很好地处理连贯的选择以及多个选定的行，但在处理多列时会失败。

子系统的当前输出可以在这张图片中看到: multiple columns failed

正如人们所期望的那样，我希望 .csv 文件(或相应的 .txt 文件)如下所示: multiple columns desired output

如何实现最后一种情况的预期行为？有人会好心地将链接作为图像包含在内吗？当然，如果认为合适的话。

Answer 1

这可能看起来有点复杂，但您的用例并不是很简单......

它确实假设每个选定区域的大小相同，并且它们全部对齐(作为行或列)

Sub Tester()

Dim s As String, srow As String, sep As String
Dim a1 As Range, rw As Range, c As Range, rCount As Long
Dim areaCount As Long, x As Long
Dim bColumnsSelected As Boolean
Dim sel As Range

    bColumnsSelected = False
    Set sel = Selection

    areaCount = Selection.Areas.Count
    Set a1 = Selection.Areas(1)

    If areaCount > 1 Then
        If a1.Cells(1).Column <> Selection.Areas(2).Cells(1).Column Then
            'areas represent different columns (not different rows)
            bColumnsSelected = True
            Set sel = a1
        End If
    End If

    rCount = 0

    For Each rw In sel.Rows

        rCount = rCount + 1
        srow = ""
        sep = ""

        For Each c In rw.Cells
            srow = srow & sep & Replace(c.Text, ",", ".")
            sep = ","
        Next c

        'if there are multiple areas selected (as columns), then include those
        If bColumnsSelected Then
            For x = 2 To areaCount
                For Each c In Selection.Areas(x).Rows(rCount).Cells
                    srow = srow & sep & Replace(c.Text, ",", ".")
                Next c
            Next x
        End If

        s = s & IIf(Len(s) > 0, vbCrLf, "") & srow
    Next rw

    Debug.Print s

End Sub