將選定的行和列導出到CSV文件

Question

我希望能夠使用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 

正如我已經提到的子相干的選擇，並與多個選定的行工作得很好，但是當涉及到多個列失敗。

子的電流輸出可以在此位置圖片上可以看出： 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