VBA 创建一个 for 循环以将数据复制到单独的文本文件中答案

【问题标题】：VBA creating a for loop to copy data into separate text filesVBA 创建一个 for 循环以将数据复制到单独的文本文件中
【发布时间】：2018-02-05 09:11:37
【问题描述】：

我创建了一个代码，当单击按钮时，它将保存我的 Excel 电子表格的 2 列中的数据。我想创建一个 For 循环来保存多个文本文件。每个文本文件都将包含 B 列中的数据，但是对于第二列，将从 C 列循环到 N 列。即第一个文本文件将包含 B 和 C 列的数据，第二个文本文件将包含 B 和 D 列的数据，第三个文本文件将包含 B 和 E 列等。

这是我目前的代码，没有循环

Private Sub CommandButton1_Click()

Dim wbText As Workbook
Dim wsReports As Worksheet

Set wbText = Workbooks.Add

Set wsReports = ThisWorkbook.Worksheets("Temps_protected_profile")

With wsReports

    Dim lRow As Long
    lRow = .Range("B" & .Rows.Count).End(xlUp).Row

    wbText.Sheets(1).Range("B1") = "<TEMPERATURES>"
    wbText.Sheets(1).Range("B2") = lRow - 2

    .Range("B3:B" & lRow).Copy wbText.Sheets(1).Range("B3")
    .Range("C3:C" & lRow).Copy wbText.Sheets(1).Range("C3")


End With

Application.DisplayAlerts = False

With wbText

    .SaveAs Filename:="C:\Users\Tom\Desktop\Cell1.txt", _
    FileFormat:=xlText
    .Close False

End With

Application.DisplayAlerts = True

End Sub

对于每个文本文件的命名，我想每次在名称的末尾添加一个数字，即第一个文本文件将称为“Cell1”，第二个将称为“Cell2”。

如果有人可以帮助我解决这些问题，将不胜感激！我对 VBA 完全陌生，我真的很难开始循环

【问题讨论】：

标签： vba excel for-loop

【解决方案1】：

没有你的文件我没有测试它，但我相信它应该可以工作。

Private Sub CommandButton1_Click()

Dim wbText As Workbook
Dim wsReports As Worksheet
Dim i as Long
Set wsReports = ThisWorkbook.Worksheets("Temps_protected_profile")    
For i = 3 to 14
Set wbText = Workbooks.Add

With wsReports
    Dim lRow As Long
    lRow = .Range("B" & .Rows.Count).End(xlUp).Row

    wbText.Sheets(1).Range("B1") = "<TEMPERATURES>"
    wbText.Sheets(1).Range("B2") = lRow - 2

    .Range("B3:B" & lRow).Copy wbText.Sheets(1).Range("B3")
    .Range(.Cells(3,i), .Cells(lRow,i)).Copy wbText.Sheets(1).Range("C3")

End With
Application.DisplayAlerts = False

With wbText

    .SaveAs Filename:="C:\Users\Tom\Desktop\Cell" & i - 2 & ".txt", _
    FileFormat:=xlText
    .Close False

End With
Application.DisplayAlerts = True
Next

End Sub

【讨论】：

【解决方案2】：

您可以按照此代码进行操作（请参阅 cmets 了解说明）

Option Explicit

Private Sub CommandButton1_Click()
    Dim firstColumnRng As Range
    Dim cell As Range

    With ThisWorkbook.Worksheets("Temps_protected_profile") 'reference "source" sheet
        Set firstColumnRng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp)) ' set referenced sheet range to be copied as first column
        For Each cell In .Range("C3:N3") ' loop through referenced sheet columns C to N
            With Workbooks.Add 'add and reference a new workbook
                With .Sheets(1) ' reference new workbook first sheet
                    .Range("B1:B2") = Application.Transpose(Array("<TEMPERATURES>", firstColumnRng.Rows.Count)) ' write two cells in one shot with Array() function
                    firstColumnRng.Copy .Range("B3") ' copy "source" sheet first column values and paste them into referenced sheet from cell B3 downwards
                    cell.Resize(firstColumnRng.Rows.Count).Copy .Range("C3") ' copy "source" sheet current loop cell column values and paste them into referenced sheet from cell C3 downwards
                End With

                Application.DisplayAlerts = False
                .SaveAs Filename:="C:\Users\Tom\Desktop\Cell" & Format(cell.Column - 2, "00") & ".txt", FileFormat:=xlText 'save referenced workbook
                .Close False 'close referenced workbook without saving changes
                Application.DisplayAlerts = True
            End With
        Next
    End With
End Sub

【讨论】：