在 VBA Excel 中遍历工作表和列时遇到问题答案

【问题标题】：Trouble iterating over both worksheets and columns in VBA Excel在 VBA Excel 中遍历工作表和列时遇到问题
【发布时间】：2013-09-27 17:03:17
【问题描述】：

我目前在同一个工作表的 78 个工作表的某个列中有数据，我想将这些数据复制到我的工作簿中名为“表 2”的另一个表中。本质上我在 78 个工作表中的每个工作表中获取范围 B3:B195 中的数字，然后将其粘贴到“工作表 2”中的一列中，这样当子完成时，工作表 2 应该有 78 列，每列都包含来自其中一个的数据工作表。但是，当我运行宏时，工作表中没有任何反应，当我进入宏时，似乎只是跳过了循环。

Sub TransferData()
Dim numSheets As Long
Dim columnsAcross As Long
Dim lengthOfColumn As Long
Dim columnCounter As Long
Dim sht As Worksheet
Dim y As String

For numSheets = 2 To numSheets = 79
    columnCounter = 1
        For lengthOfColumn = 1 To lengthOfColumn = 192
            y = "B" & (columnCounter + 3)
            Worksheets("Sheet 2").Range(Cells(lengthOfColumn, numSheets), Cells(lengthOfColumn, numSheets)) = Worksheets(numSheets).Range(y)
            columnCounter = columnCounter + 1
        Next lengthOfColumn
Next numSheets

End Sub

【问题讨论】：

标签： vba excel nested-loops

【解决方案1】：

Sub TransferData()
Dim numSheets As Long
Dim columnCounter As Long
Dim wb As Workbook

    Set wb = ThisWorkbook
    columnCounter = 1
    For numSheets = 2 To numSheets = 79

        wb.Worksheets(numSheets).Range("B3:B195").Copy _
            wb.Worksheets("Sheet 2").Cells(1, columnCounter)

        columnCounter = columnCounter + 1

    Next numSheets

End Sub

【讨论】：

+ 1 该死！该死！该死！哈哈
代码根本不起作用。我应该发布指向工作簿的链接吗？
不，您的宏没有做任何事情，也没有给出错误，但 Siddharth Rout 的回答有效。无论如何，谢谢。

【解决方案2】：

未经测试

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Sheets(1)

    For i = 2 To 79
        ThisWorkbook.Sheets(1).Range( _
                                     Split(Cells(, i - 1).Address, "$")(1) & _
                                     "2:" & _
                                     Split(Cells(, i - 1).Address, "$")(1) & _
                                     "195" _
                                     ).Value = _
        ThisWorkbook.Sheets(i).Range("B2:B195").Value
    Next i
End Sub

跟进（来自评论）

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Sheets(1)

    For i = 2 To 79
        '~~> Get Values from A1
        ThisWorkbook.Sheets(1).Range( _
                                     Split(Cells(, i - 1).Address, "$")(1) & _
                                     "1" _
                                     ).Value = _
        ThisWorkbook.Sheets(i).Range("A1").Value

        '~~> Get the column Values
        ThisWorkbook.Sheets(1).Range( _
                                     Split(Cells(, i - 1).Address, "$")(1) & _
                                     "2:" & _
                                     Split(Cells(, i - 1).Address, "$")(1) & _
                                     "195" _
                                     ).Value = _
        ThisWorkbook.Sheets(i).Range("B2:B195").Value
    Next i
End Sub

【讨论】：

我可以看看你的 Excel 文件吗？
没关系，它起作用了，但你能告诉我如何再做一件事吗？我需要将每张工作表中单元格 A1 的内容添加到新工作表中每一列的顶部，即 78 列。
@user10055：更新了帖子。希望这是你想要的？

【解决方案3】：

假设您的背面有 Sheet 2（最后一张）

Sub Test()
    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Sheet 2")

    For i = 1 To 78
        ws.Range("A1:A193").Offset(0, i - 1) = ThisWorkbook.Sheets(i).Range("B3:B195").Value
    Next i
End Sub

【讨论】：