Vba 带.Find方法的无限循环

我正在尝试编写一个VBA脚本，以便在从会计软件导入资产负债表的电子表格中自动移动数据。 导入的资产负债表上的值从第5行开始，A列有一些文字描述了每行值的含义，B列和D列有每个项目的金额

资产负债表各部分和子部分的小计列在C列和E列。每个小计列在一个单元格中，格式为实心上边框

我想将所有这些小计与值放在同一列（即B列和D列）。我尝试使用.Find方法搜索具有特定格式的单元格（具有上边框的单元格），并使用do循环继续搜索，直到找到所有应包含小计的单元格

注:

我没有使用FindNext，因为它似乎忽略了前面的Find方法中使用的格式设置，如前所述

我试图用FindNext解决这个问题，但它没有找到所有具有指定格式的单元格

这是密码。非常感谢您的帮助

Sub FixBalanceSheet()
  Dim LookFor As Range
  Dim FoundHere As String 'Address of the cell that should contain a subtotal
  Dim beginAt As Range, endAt As Range, rng As Range 'Set the ranges for the sum to get the subtotal
  Dim place As String 'String with the address of a cell that will contain a subtotal
  Dim WhereToLook As Range 'Range where subtotals are to be found

  'Set workbook and worksheet
  With Sheets("Sheet1")
    Set WhereToLook = Range("A5:F100")
    'Every cell containing a subtotal has an upper border. So, look for cells containing border!
    With Application.FindFormat.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    'Call search using .Find
    Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
        LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=True)
    If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
      'What happens when a subtotal cell is found:
      FoundHere = LookFor.Address
      Debug.Print "Found at: " & Found
      'Loop to set a range, sum values and put them in the right cell
      Do
       '% find out a range to calculate subtotals and put the value in the right cells  %'
        'Call for next search
        With Application.FindFormat.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        End With
        Set LookFor = WhereToLook.Find(What:="", After:=endAt, SearchFormat:=True)
        Debug.Print "LookFor now is: " & LookFor.Address
        Rem If LookFor.Address = Found Then ' Do not allow wrapped search
          Rem Exit Do
        Rem End If
      Loop Until LookFor Is Nothing Or LookFor.Address = FoundHere ' Do not allow wrapped search
    End If
  End With
End Sub

---

我建议回到/。你的逻辑条件有一些漏洞，我相信我已经调整了

Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
    LookIn:=xlFormulas, LookAt:=xlPart, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
  'What happens when a subtotal cell is found:
  FoundHere = LookFor.Address
  Debug.Print "Found at: " & FoundHere
  'Loop to set a range, sum values and put them in the right cell
  Do

   'do something with LookFor as a Range Object here

    'Call for next search
    Set LookFor = WhereToLook.FindNext(After:=LookFor)   '<~~ look for next after current cell
    Debug.Print "LookFor now is: " & LookFor.Address
  Loop Until LookFor.Address = FoundHere ' Do not allow wrapped search (LookFor will never be nothing here)
End If

Set LookFor=WhereToLook.Find（What:=”，After:=单元格（5,2）_
LookIn:=xl公式，LookAt:=xlPart_
SearchOrder:=xlByRows，SearchDirection:=xlNext_
MatchCase:=False，SearchFormat:=True）
如果NotLookFor为Nothing，则“测试是否找到具有底部边框的单元格”
'找到小计单元格时会发生什么情况：
FoundHere=LookFor.Address
Debug.Print“在以下位置找到：”&FoundHere
'循环以设置范围、求和值并将其放入正确的单元格
做
'在此处将查找作为范围对象执行某些操作
'要求下一次搜索
设置LookFor=WhereToLook.FindNext（在：=LookFor之后）“我建议回到/。你的逻辑条件有一些漏洞，我相信我已经调整了

Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
    LookIn:=xlFormulas, LookAt:=xlPart, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
  'What happens when a subtotal cell is found:
  FoundHere = LookFor.Address
  Debug.Print "Found at: " & FoundHere
  'Loop to set a range, sum values and put them in the right cell
  Do

   'do something with LookFor as a Range Object here

    'Call for next search
    Set LookFor = WhereToLook.FindNext(After:=LookFor)   '<~~ look for next after current cell
    Debug.Print "LookFor now is: " & LookFor.Address
  Loop Until LookFor.Address = FoundHere ' Do not allow wrapped search (LookFor will never be nothing here)
End If

Set LookFor=WhereToLook.Find（What:=”，After:=单元格（5,2）_
LookIn:=xl公式，LookAt:=xlPart_
SearchOrder:=xlByRows，SearchDirection:=xlNext_
MatchCase:=False，SearchFormat:=True）
如果NotLookFor为Nothing，则“测试是否找到具有底部边框的单元格”
'找到小计单元格时会发生什么情况：
FoundHere=LookFor.Address
Debug.Print“在以下位置找到：”&FoundHere
'循环以设置范围、求和值并将其放入正确的单元格
做
'在此处将查找作为范围对象执行某些操作
'要求下一次搜索
设置lookfort=WhereToLook.FindNext（在：=lookfort之后）“考虑使用范围对象在范围内循环。如果需要总计，可以添加总计，但这可能比尝试选择所有具有格式的单元格更简单

例如：

Sub TestStackOverflowCode()
    Dim r As Range
    Dim rngToChk As Range

    'This is where you'd insert WhereToLook
    Set rngToChk = ActiveSheet.Range("B1:B4")

    For Each r In rngToChk

        'If the top edge does not NOT have a border
        If r.Borders(xlEdgeTop).LineStyle <> xlNone Then
            'Copy the cell value to two cells to the right
            r.Offset(, 2).Value = r.Value
        End If
    Next r

End Sub

子TestStackOverflowCode（）
调光范围
变暗RNGTOCKAS范围
'这是您要插入where-look的位置
设置rngToChk=ActiveSheet.Range（“B1:B4”）
对于rngToChk中的每个r
'如果顶部边缘没有边框
如果为r.Borders（xlEdgeTop）.LineStyle xlNone，则
'将单元格值复制到右侧的两个单元格
r、 偏移量（，2）.值=r.值
如果结束
下一个r
端接头
考虑使用范围对象在范围内循环。如果需要总计，可以添加总计，但这可能比尝试选择所有具有格式的单元格更简单

例如：

Sub TestStackOverflowCode()
    Dim r As Range
    Dim rngToChk As Range

    'This is where you'd insert WhereToLook
    Set rngToChk = ActiveSheet.Range("B1:B4")

    For Each r In rngToChk

        'If the top edge does not NOT have a border
        If r.Borders(xlEdgeTop).LineStyle <> xlNone Then
            'Copy the cell value to two cells to the right
            r.Offset(, 2).Value = r.Value
        End If
    Next r

End Sub

子TestStackOverflowCode（）
调光范围
变暗RNGTOCKAS范围
'这是您要插入where-look的位置
设置rngToChk=ActiveSheet.Range（“B1:B4”）
对于rngToChk中的每个r
'如果顶部边缘没有边框
如果为r.Borders（xlEdgeTop）.LineStyle xlNone，则
'将单元格值复制到右侧的两个单元格
r、 偏移量（，2）.值=r.值
如果结束
下一个r
端接头
如果出现以下情况，findNext可能不起作用


在[Set LookFor=WhereToLook.Find（…]

我确实认为ThreeTrickPony的答案更为优雅，但总的来说，我建议寻找一种替代方法来识别单元格，而不是格式化


在[Set LookFor=WhereToLook.Find（…]

我确实认为ThreeTrickPony的答案更为优雅，但总的来说，我建议找到另一种方法来识别单元格，而不是格式化。
在随后的每次搜索中，你都没有重新指定endAt来查找……对了，Flephal，这就是他知道自己在终点/注视点的方式。感谢Flephal，这就是造成无穷lo的原因哎呀！它没有找到所有带边框的单元格。你没有在以后的每次搜索中重新指定endAt来寻找……对了，弗莱法尔，这就是他知道自己在末尾/起始点的原因。谢谢弗莱法尔，这就是造成无穷循环的原因！不过，它没有找到所有带边框的单元格。