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

我希望能够使用VBA将选定范围的单元格导出到.csv文件。 到目前为止，我所做的工作对于select合作来说是出色的，但是在select多个专栏的时候，这种工作是不可思议的。

这里是我从互联网上find的代码片段中设置的代码：它也摆弄了一些用户界面，因为我的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 

正如我已经提到的子作品与连贯的select，也与多个选定的行，但失败，当涉及到多个列。

在这里可以看到sub的当前输出： 多列失败

正如人们所期望的那样，我希望.csv文件（或相应的.txt文件）看起来像这样： 多列所需的输出

我怎样才能达到最后的情况所需的行为？ 而且有人会把这些链接包含在图像中吗？ 当然如果感觉合适的话。

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