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

Excel 将选定的行和列导出到CSV文件,excel,vba,Excel,Vba,我希望能够使用VBA将选定范围的单元格导出为.csv文件。到目前为止,我提出的方法在凝聚选择方面做得很好,但在选择多个列时却失败了 下面是我从互联网上找到的代码片段中拼凑出来的代码:它还可以摆弄一些用户界面,因为我的Excel讲德语,我需要用“.”而不是“.”作为十进制分隔符,它调整了这一点 Sub Range_Nach_CSV_() Dim vntFileName As Variant Dim lngFN As Long Dim rngRow As Excel.Range Dim rngCel

我希望能够使用VBA将选定范围的单元格导出为.csv文件。到目前为止,我提出的方法在凝聚选择方面做得很好,但在选择多个列时却失败了

下面是我从互联网上找到的代码片段中拼凑出来的代码:它还可以摆弄一些用户界面,因为我的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
正如我已经提到的,sub可以很好地处理连贯的选择,也可以处理多个选定的行,但在处理多个列时失败

sub的电流输出可在下图中看到:

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

我如何才能实现最后一个案例的预期行为?
有人会这么好心,包括图片的链接?当然,如果感觉合适的话。

这可能看起来有点复杂,但您的用例并不简单

它假定每个选定区域的大小相同,并且它们都对齐(作为行或列)

子测试仪()
Dim s作为字符串,srow作为字符串,sep作为字符串
尺寸a1作为范围,rw作为范围,c作为范围,rCount作为长度
变暗区域计数为长,x为长
尺寸B列选择为布尔值
昏暗的选择范围
bColumnsSelected=False
设置sel=选择
areaCount=Selection.Areas.Count
设置a1=选择区域(1)
如果面积计数>1,则
如果a1.单元格(1).列选择.区域(2).单元格(1).列,则
'区域表示不同的列(不是不同的行)
bColumnsSelected=True
设置sel=a1
如果结束
如果结束
rCount=0
对于选择行中的每个rw
rCount=rCount+1
srow=“”
sep=“”
对于rw.单元格中的每个c
srow=srow&sep&Replace(c.Text,“,”,“)
sep=“,”
下一个c
'如果选择了多个区域(作为列),则包括这些区域
如果选择了B列,则
对于x=2的区域计数
对于所选区域中的每个c。区域(x)。行(rCount)。单元格
srow=srow&sep&Replace(c.Text,“,”,“)
下一个c
下一个x
如果结束
s=s&IIf(长度>0,vbCrLf,“”)&srow
下一个rw
调试。打印s
端接头

+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