Excel 从搜索的单元格值开始复制动态范围数组

我有一大堆数据：

其中，我只需要将此数据的特定部分复制到另一个工作表：

我需要复制的数据总是4个单元格宽，但可以是任何行和列。顶部的第一列单元格将始终是相同的文本值，我需要从找到的单元格复制，从右到右再向下的4个单元格都是空的。第一个范围之后的所有后续范围将使用相同的列，在每个所需范围的上方和下方都有几个空单元格。宏将使用“按钮”运行，因此不需要一直检查单元格的值。这些图像是数据的简化版本，但非常准确。0用于显示范围周围的数据，HELLO是范围内的数据，INT_EXT_DOOR是我搜索的单元格值，该值可以位于数据集之间的任何列中，但在每个数据集中都相同。第一个范围始终从第2行开始

每个范围都必须编号，由另一个工作表单元格值定义。例如，如果我的单元格值为1，我需要它复制范围1，如果我的值为2，则复制范围2 ect

---

我一直在努力，希望能得到所需的任何帮助。谢谢。

测试下一个功能，请：

Private Function testReturnBlock(strBlock As String, blkNo As Long)
   Dim sh As Worksheet, ws As Worksheet, lastRow As Long, searchC As Range
   Dim rng As Range

    Set sh = ActiveSheet ' use here your sheet to be processed
    Set ws = Worksheets("Return") 'use here your sheet where the data will be returned

    Set searchC = sh.UsedRange.Find(strBlock)
    If searchC Is Nothing Then MsgBox "No such a field in the worksheet...": Exit Function

    lastRow = sh.Cells(Rows.Count, searchC.Column).End(xlUp).row
    'The following part works well only if the blocks are separated by empty rows, as you said it is your sheet data case...
    Set rng = sh.Range(searchC, sh.Cells(LastRow, searchC.Column)).SpecialCells(xlCellTypeConstants)
     ws.Range("A1").Resize(rng.Areas(blkNo).Rows.Count, 4).Value = rng.Areas(blkNo).Resize(, 4).Value
End Function

上述函数应按如下方式调用：

Sub testRetBlock()
   testReturnBlock "INT_EXT_DOOR", 2
End Sub

---

但是为了查看返回的范围是否正确，您必须以某种方式（在测试表中）对其进行调整，并进行区分。我的意思是第二个包含“HELLO1”（至少在第一行）、下面的“HELLO2”等等…

如果它能满足您的需要，请尝试这个例程。否则，这应该是一个很好的开始，可以在上面添加任何您需要的内容

Option Explicit

Sub CopyBlock()
    Dim wb As Excel.Workbook
    Dim wsSource As Excel.Worksheet
    Dim wsDest As Excel.Worksheet
    Dim wsSelect As Excel.Worksheet
    Dim lBlockNo As Long
    Dim strCellID As String
    Dim lBlock As Long
    Dim lRow As Long
    Dim lBlockRow As Long
    Dim lBlockCol As Long
    Dim searchRange As Excel.Range
    Dim bRange As Excel.Range
    Dim cRange As Excel.Range

    Set wb = ActiveWorkbook

' set the worksheet objects
    Set wsSource = wb.Sheets("Source")
    Set wsDest = wb.Sheets("Dest")
    Set wsSelect = wb.Sheets("Select")      ' here you select which block you want to copy

' Identifier String
    strCellID = "INT_EXT_DOOR"

' Which block to show. We assume that the number is in cell A1, but could be anywhere else
    lBlockNo = wsSelect.Range("A1")

    lRow = 1

' Find block with lBlockNo
    For lBlock = 1 To lBlockNo

' Search the identifier string in current row
        Do
            lRow = lRow + 1
            Set searchRange = wsSource.Rows(lRow)
            Set bRange = searchRange.Find(strCellID, LookIn:=xlValues)
        Loop While (bRange Is Nothing)

    Next lBlock

    lBlockRow = bRange.Row
    lBlockCol = bRange.Column

' Search the first with empty cell
    Do
        lRow = lRow + 1
    Loop While wsSource.Cells(lRow, lBlockCol) <> ""

' Copy the range found into the destination sheet
    Range(Cells(lBlockRow, lBlockCol), Cells(lRow - 1, lBlockCol + 3)).Copy wsDest.Range("A1")

' Note the block copied
    wsDest.Cells(1, 6) = "Block No:"
    wsDest.Cells(1, 8) = lBlockNo

' Clean up (not absolutely necessary, but good practice)
    Set searchRange = Nothing
    Set bRange = Nothing
    Set cRange = Nothing
    Set wsSource = Nothing
    Set wsDest = Nothing
    Set wsSelect = Nothing
    Set wb = Nothing

End Sub

选项显式
子复制块（）
将wb设置为Excel.工作簿
将wsSource设置为Excel.工作表
将wsDest设置为Excel.工作表
选择为Excel.Worksheet
不，没有那么长
像字符串一样的模糊结构
长时变暗
暗淡的光线和长的一样
我和洛克罗一样长
暗淡如长
将搜索范围设置为Excel.Range
暗膜为Excel.Range
如Excel.Range所示的尺寸范围
设置wb=ActiveWorkbook
'设置工作表对象
设置wsSource=wb.Sheets（“源”）
设置wsDest=wb.Sheets（“Dest”）
设置wsSelect=wb.Sheets（“选择”），在这里您可以选择要复制的块
'标识符字符串
strCellID=“内外门”
“显示哪个街区。我们假设数字在单元格A1中，但可能在其他任何地方
lBlockNo=wsSelect.Range（“A1”）
lRow=1
'查找具有lBlockNo的块
对于lBlock=1到lBlock否
'搜索当前行中的标识符字符串
做
lRow=lRow+1
设置searchRange=wsSource.Rows（lRow）
Set bRange=searchRange.Find（strCellID，LookIn:=xlValues）
循环时（bRange什么都不是）
下一个lBlock
lBlockRow=bRange.Row
lBlockCol=bRange.列
'使用空单元格搜索第一个单元格
做
lRow=lRow+1
循环wsSource.Cells（lRow，lBlockCol）”“
'将找到的范围复制到目标工作表中
范围（单元格（lBlockRow，lBlockCol），单元格（lRow-1，lBlockCol+3））。复制wsDest.Range（“A1”）
'请注意，已复制块
wsDest.Cells（1，6）=“块号：”
wsDest.Cells（1,8）=lBlockNo
“清理（并非绝对必要，但良好做法）
设置searchRange=Nothing
设为零
设置起重机=无
设置wsSource=Nothing
设置wsDest=Nothing
设置wsSelect=Nothing
设置wb=Nothing
端接头

---

如果您需要更多帮助，请告诉我

您自己尝试过什么吗？也许我们可以更好地理解你真正想要实现的目标。您是否可以编辑您的问题并添加至少两张图片（如果不是可编辑的），以显示您的初始情况、搜索规则以及结果的外观。你说过要复制到另一个工作表。这样的工作表太大了。。。在这张工作表中，第一个要复制的区域在哪里？您一直在尝试的一段代码，可能会让我们比您的文字解释更了解…只是重复一下我的理解：您有一块数据，大小为4*X个单元格（X=#行）。在您的示例中，此块的单元格（1,1）始终具有“INT_EXT_DOOR”，但此单元格可以位于给定行的任何列中。从这里开始，您必须沿行循环，直到找到第一个空单元格。根据另一张图纸中的单元，需要选择给定图纸中的第n个块。每行最多有一个“单元格（1,1）。如果这是正确的，我可以开始为您的任务考虑一段代码。是的，超级瘾君子，这是正确的。单元格（1,1）在每个块中仅出现在1,1处，仅在块范围的第一个实例中不出现在空单元格下。向我们展示您的尝试将有助于理解您的问题，并制定解决方案。这看起来像是

range。Find

方法将是一个很好的起点。@Nathan Barrow:那么，它是否满足了您在应用程序中的要求问题？很好的解决方案，比我的短：-）。但我最近了解到，你需要小心使用“usedRange”“因为它受空单元格的影响，在某些情况下返回falseresults@Ultra吸毒者：不太可能，在这种情况下。如果您试图定义它的最后一行、最后一列，它可能会返回错误的结果。如果您将写下或右边的一些行，然后删除它们，那么UsedRange将包括它们。我会为一些新行设置格式，这些新行也会包括在内。但是在上面的代码情况下，使用它是最简单、最短且没有任何risc的

Find

函数来正确返回内部。它不受“空行”的影响，因为它缺少一些东西。对于您的解决方案，在我的工作中，它将4列复制到“INT\u EXT\u DOOR”的右侧。这个例子很好，但是，你知道是什么原因导致它被关闭了吗？我已经在谷歌上搜索了所有不同的部分