.Find 方法的无限循环

Question

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

资产负债表的每个部分和子部分的小计位于 C 和 E 列。每个小计都位于一个带有实心上边框的单元格中。

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

注意事项：

1. 我没有使用 FindNext，因为它似乎忽略了前面 Find 方法中使用的格式设置，如 here 所述。
2. 我尝试使用 FindAll function described by Tushar Mehta 来解决 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

Answer 1

考虑使用范围对象循环遍历您的范围。如果需要总计，可以添加总计，但这可能比尝试选择所有具有格式的单元格更简单。

例如：

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

Answer 2

我建议回到Range.Find/Range.FindNext method。您的逻辑条件存在一些漏洞，我相信我已经对其进行了调整。

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

Answer 3

如果发生这种情况，findNext 可能不起作用

• 在 [Set LookFor = WhereToLook.Find(...] 之后有 [FindFormat.Borders...]

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