Excel 如何在工作表的多个区域中循环？

我正在寻找一些VBA，它允许我在工作表上循环几个不同的区域。不一定是单个单元格，而是从当前区域跳到下一个当前区域。定位区域后，应选择并复制该区域

我尝试通过Cells.FindWhat:=*设置StartCell，然后使用该单元格选择相应的“currentregion”。问题是如何移动到下一个“currentregion”，直到工作表上的所有“currentregions”都被复制/粘贴

到目前为止，我的结果是不一致的，有时所有必要的区域都被复制/粘贴，但有时某些区域被忽略，即相同的精确工作表、相同的精确数据

Set StartCell = Cells.Find(What:="*", _
                    After:=Cells(Rows.Count, Columns.Count), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)Do

            'Select Range and copy it
              If StartCell <> "" Then
              StartCell.currentregion.CopyPicture

            'Select a cell to paste the picture in
              Range("A16").PasteSpecial

            'Move to next range to be copied

            Set StartCell = StartCell.End(xlToRight).End(xlToRight)
           StartCell.Select
            End If

        Loop Until StartCell = ""

---

这样的办法应该行得通

Option Explicit

Public Sub ProcessEachRegion()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'define your sheet

    Dim StartCell As Range
    Set StartCell = ws.Range("A1") 'define start cell

    Do Until StartCell.Column = ws.Columns.Count 'loop until end of columns
        With StartCell.CurrentRegion
            'do all your copy stuff here!
            '.Copy
            'Destination.Paste


            Set StartCell = .Resize(1, 1).Offset(ColumnOffset:=.Columns.Count - 1).End(xlToRight)
        End With
    Loop
End Sub

它将查找下一个区域，该区域位于下一个区域的右侧，即下面示例中的区域1到5

名为tgr的主子元素将调用名为GetAllPopulatedCells的函数，该函数为工作表中所有填充的单元格定义一个范围。.Areas属性将允许您通过每个区域进行循环。然后，它会将每个区域/区域复制为一张图片，但仍不确定您为什么要这样做，并将其放入目标单元格中，然后根据需要调整目标单元格，以便所有粘贴的图像都堆叠在彼此的顶部

Sub tgr()

    Dim ws As Worksheet
    Dim rAllRegions As Range
    Dim rRegion As Range
    Dim rDest As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set rAllRegions = GetAllPopulatedCells(ws)
    Set rDest = ws.Range("A16")

    If rAllRegions Is Nothing Then
        MsgBox "No populated cells found in '" & ws.Name & "'. Exiting Macro.", , "Error"
        Exit Sub
    End If

    For Each rRegion In rAllRegions.Areas
        rRegion.CopyPicture
        rDest.PasteSpecial
        Set rDest = rDest.Offset(rRegion.Rows.Count)
    Next rRegion

End Sub

Public Function GetAllPopulatedCells(Optional ByRef arg_ws As Worksheet) As Range

    Dim ws As Worksheet
    Dim rConstants As Range
    Dim rFormulas As Range

    If arg_ws Is Nothing Then Set ws = ActiveWorkbook.ActiveSheet Else Set ws = arg_ws

    On Error Resume Next
    Set rConstants = ws.Cells.SpecialCells(xlCellTypeConstants)
    Set rFormulas = ws.Cells.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    Select Case Abs(rConstants Is Nothing) + 2 * Abs(rFormulas Is Nothing)
        Case 0: Set GetAllPopulatedCells = Union(rConstants, rFormulas)
        Case 1: Set GetAllPopulatedCells = rFormulas
        Case 2: Set GetAllPopulatedCells = rConstants
        Case 3: Set GetAllPopulatedCells = Nothing
    End Select

    Set ws = Nothing
    Set rConstants = Nothing
    Set rFormulas = Nothing

End Function

---

欢迎来到堆栈溢出。请注意，我们不能提供任何代码，因为这不是免费的代码编写服务。有必要通过显示代码来显示您迄今为止尝试过的内容、遇到的问题或错误，或者至少显示您所做的研究和努力。否则它只是要求我们为你做所有的工作。如果您展示了您尝试过的代码或提供了一个示例，我们可以帮助您。阅读也可以帮助你改进你的问题。你为什么使用.CopyPicture？您希望复制的信息输出到哪里？现在它只是被贴在彼此的上面，作为A16单元格中的图像…如果你能大致解释一下你的区域是如何排列在工作表上的，这将有助于你的问题。全部在一行/网格/列中？随机？所有现有区域当前并排排列，以这种方式水平穿过Biz对象的输出。我的经理希望他们复制/粘贴成图片b，垂直排列在电子表格上。是的，我知道它们都被复制到同一个单元格。这是因为我工作的步骤很小，在继续下一步之前，我会努力让每一段代码都正常工作。我的下一步将是以某种有组织的方式重新排列所有粘贴的图片。此外，如果我上面的代码示例看起来像是疯狂的谈话，那是因为我将各种东西拼凑在一起，直到有东西起作用。我知道这对效率来说不是最好的。相信我，我也不明白为什么复制/粘贴图片。我将尝试一下，看看我的结局如何。我会回来报到的。谢谢