将多个范围导出到txt文件

Question

我需要将不同工作表中的多个范围导出到单个文本文件中我希望单元格范围一个接一个地附加。目前我正在使用这个代码，它适用于一个范围的工作表，我需要修改它以使其适用于更多范围？

示例范围我想添加

Sheet1 A2:E50
Sheet2 A2:F60
Sheet4 A2:C45

当前代码

Sub Export()
Dim r As Range, c As Range
Dim sTemp As String

Open Workbooks("Test.xlsm").Path & "\Test.SQL" For Output As #1
For Each r In Worksheets("SQL1").Range("A1:D50").Rows
    sTemp = ""
    For Each c In r.Cells
        sTemp = sTemp & c.Text & Chr(9)
    Next c

    'Get rid of trailing tabs
    While Right(sTemp, 1) = Chr(9)
        sTemp = Left(sTemp, Len(sTemp) - 1)
    Wend
    Print #1, sTemp
Next r
Close #1
End Sub

Answer 1

就像我在上面的评论中提到的，这是将这些范围导出到文本文件的最快方法。不需要循环......

<强>未测试

Dim Thiswb As Workbook, thatWb As Workbook

Sub Sample()
    Set Thiswb = ThisWorkbook
    Set thatWb = Workbooks.Add

    CopyRange Thiswb.Sheets("Sheet1"), Thiswb.Sheets("Sheet1").Range("A1:E10000")
    CopyRange Thiswb.Sheets("Sheet2"), Thiswb.Sheets("Sheet2").Range("A1:F10000")
    CopyRange Thiswb.Sheets("Sheet3"), Thiswb.Sheets("Sheet3").Range("A1:C10000")

    Application.DisplayAlerts = False
    thatWb.SaveAs "C:\Temp.csv", xlCSV
    Application.DisplayAlerts = True
End Sub

Sub CopyRange(ws As Worksheet, rng As Range)
    Dim lRow As Long

    lRow = thatWb.Sheets(1).Range("A" & thatWb.Sheets(1).Rows.Count).End(xlUp).Row + 1

    rng.Copy thatWb.Sheets(1).Range("A" & lRow)
End Sub

评论后续跟进

  

Siddharth这很有用但不适合我，因为我的上面的代码插入到SQL和JAVA中，你能不能告诉我如何修改上面的代码以在不同的表格上执行多种范围，不管这是不是最好的方法，不幸的是我对VBA不是很好:( - 风车5分钟前

这是你在尝试什么？ （的未测试）

Sub Sample()
    Dim Thiswb As Workbook
    Set Thiswb = ThisWorkbook

    Export Thiswb.Sheets("Sheet1").Range("A2:E50")
    Export Thiswb.Sheets("Sheet2").Range("A2:F60")
    Export Thiswb.Sheets("Sheet4").Range("A2:C45")
End Sub

Sub Export(rng As Range)
    Dim r As Range, c As Range
    Dim sTemp As String

    '~~> Use Append instead of Output
    Open Workbooks("Test.xlsm").Path & "\Test.SQL" For Append As #1

    For Each r In rng.Rows
        sTemp = ""
        For Each c In r.Cells
            sTemp = sTemp & c.Text & Chr(9)
        Next c

        'Get rid of trailing tabs
        While Right(sTemp, 1) = Chr(9)
            sTemp = Left(sTemp, Len(sTemp) - 1)
        Wend
        Print #1, sTemp
    Next r
    Close #1
End Sub