Vba Excel宏、读取工作表、选择数据范围、复制选择

我需要编写一个宏来读取岩土工程数据工作表，根据特定行中的值选择数据，选择该行并继续读取，直到工作表结束。选中所有行后，我需要将这些行复制到新的工作表中。我已经10年没做过VBA了，所以我只是想重新开始

例如，我希望宏读取工作表，当列“I”包含特定行上的单词“Run”时，我希望从该行中选择a:AM。继续阅读工作表，直到工作表结束。文档的结尾很棘手，因为工作表中的数据组之间有时会有多达10-15个空行。如果有超过25个空行，则文档将位于末尾。选择所有内容后，我需要复制所选内容以粘贴到新的工作表中。以下是迄今为止我掌握的代码，但我无法选择：

选项显式
小组委员会（）
将x作为字符串
将空格计数设置为整数
'选择第一行数据。
范围（“I2”）。选择
'设置搜索变量值和计数器。
x=“运行”
空白计数=0
“将Do循环设置为读取单元格值，增加或重置计数器，并在结束时停止循环”文档
'是“I”列中超过25个空白单元格，复制最终选择
直到BlankCount>25为止
'检查活动单元格中的搜索值“Run”。
如果ActiveCell.Value=x，则
'找到“运行”时选择数据范围
ActiveCell.Range（“A:AM”）。选择
'将计数器设置为0
空白计数=0
'从当前位置跳出1行
ActiveCell.Offset（1，0）。选择
其他的
'从当前位置跳出1行
ActiveCell.Offset（1，0）。选择
'如果单元格为空，则递增计数器
BlankCount=BlankCount+1
如果结束
环
端接头

我发现你的代码有很多地方出错。如果我正确理解了您想要的内容，则此代码应提供：

          ' Set Do loop to read cell value, increment or reset counter and stop loop at end    'document when there
          ' is more then 25 blank cells in column "I", copy final selection

  Dim x As String
  Dim BlankCount As Integer
  Range("I2").Select
  x = "Run"
  BlankCount = 0
  Dim found As Boolean
  Dim curVal As String
  Dim rowCount As Long
  Dim completed As Boolean
  rowCount = 2  
  Dim allRanges(5000) As Range
  Dim rangesCount As Long

  rangesCount = -1          
  notFirst = False
  Do Until completed
     rowCount = rowCount + 1

     curVal = Range("I" & CStr(rowCount)).Value

     If curVal = x Then
         found = True
         BlankCounter = 0
         rangesCount = rangesCount + 1
         Set allRanges(rangesCount) = Range("A" & CStr(rowCount) & ":AM" & CStr(rowCount))

     ElseIf (found) Then
        If (IsEmpty(Range("I" & CStr(rowCount)).Value)) Then BlankCount = BlankCount + 1
        If BlankCount > 25 Then Exit Do
     End If

     If (rowCount >= 5000) Then Exit Do 'In the safest-side condition to avoid an infinite loop in case of not of finding what is intended. You can delete this line
  Loop

  If (rangesCount > 0) Then
     Dim curRange As Variant
     Dim allTogether As Range
     Set allTogether = allRanges(0)
     For Each curRange In allRanges
           If (Not curRange Is Nothing) Then Set allTogether = Union(curRange, allTogether)
     Next curRange

     allTogether.Select
  End If

它从I2开始迭代第I列，直到找到单词“Run”。在这一刻，它开始计数单元格，直到达到25个（当退出循环并选择由最后一行和“Run”处的一行定义的相应范围时）。你说的是空白单元格，但你的代码没有检查，而且我也不知道如果发现非空白单元格（重新启动计数器？）该怎么办。请详细说明。

我喜欢短代码：

Sub column_I_contains_run()
        If ActiveSheet.FilterMode Then Selection.Autofilter 'if an autofilter already exists this is removed

        ActiveSheet.Range("$I$1:$I$" & ActiveSheet.Cells(1048576, 9).End(xlUp).Row).Autofilter Field:=1, Criteria1:="*run*"

    Range("A1:AM" & ActiveSheet.Cells(1048576, 9).End(xlUp).Row).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
End Sub

---

现在你只需要把它粘贴到一张新的工作表上，什么也可以自动完成…

我意识到在发布后我对代码中的空格一无所知。我想遍历列“I”。如果发现空白，我希望计数器增加。如果在“I”列中找到“run”一词，我想为该行选择A:AM列，将空白计数器重置为0，并继续向下迭代“I”列，一旦“I”列连续有25个空白行，我们就找到了文档的结尾，我想复制所选的单元格。这有意义吗？@MMayer当然。这就是我的代码所做的，除了计算空白单元格：一旦找到“开始”，只计算25个单元格。我现在就更新它，这样它就只剩下空白的了。要确保的摘要：从I2开始，一直向下，直到找到“Run”；找到时，它存储行的值（startRow）。从这一刻起，它开始计算空单元格。当空单元格数大于25时，将退出循环并选择范围。范围由A列和AM列、前面提到的startRow和退出循环前的最后一行定义。这就是你想要的吗？听起来像我想要的，我会试试你的代码，看看是否得到了想要的结果，非常感谢你的帮助。@MMayer这是选择后的（）。抱歉，短代码是很好的选择，但只有在满足另外两个条件后：它们提供准确的结果，并且与大代码一样具有适应性。您的代码没有提供OP想要的内容（在第一次“运行”之前选择所有初始行）也会以OP要求不允许的方式修改工作表（例如，在执行此选择的同时粘贴到同一工作表中的其他单元格->如果您不确定某件事，最好不要实现so“积极”方法）……此外，您的代码没有考虑25个限制；原则上，这只是为了知道工作表的结尾，但也可能是另一个原因（->这是OP的输入要求之一，除非完全确定，否则最好不要忽略它）。在适应性/可扩展性方面，没有讨论您的方法是高度不灵活的：不仅因为前面提到的对整个工作表的修改，还因为过滤器的性质（与循环、其他回答者和OP本人使用的内容相比）。想象进一步的条件“粘贴到Run2单元格中”“。op没有写关于“第一次‘运行’之前的所有行”的内容。他确实声明25限制仅用于查找文档的结尾。如果您仔细查看代码Selection.SpecialCells（xlCellTypeVisible）。Select“也许您误解了我的观点：OP不想复制所有行，直到第一次“运行”（只有带有“运行”的行），那么我认为粘贴操作没有任何问题，但您的解决方案会这样做（如果第一次“运行”不在第一行）。关于你的其他评论，我刚刚给了你我对这种解决方案的印象，你可以自由地继续以你想要的方式思考。PS：你在我的粘贴示例上是对的；我选错了一行。嗨@varocabas，只有第一行被复制，直到第一次“运行”才被复制；这可以通过选择从A2开始的范围而不是A来解决

Sub column_I_contains_run()
        If ActiveSheet.FilterMode Then Selection.Autofilter 'if an autofilter already exists this is removed

        ActiveSheet.Range("$I$1:$I$" & ActiveSheet.Cells(1048576, 9).End(xlUp).Row).Autofilter Field:=1, Criteria1:="*run*"

    Range("A1:AM" & ActiveSheet.Cells(1048576, 9).End(xlUp).Row).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
End Sub