使用 .Find 方法的无限循环

Question

我正在尝试编写一个 VBA 脚本来自动在价差 sheet 中移动东西，该价差 sheet 从会计软件导入了余额 sheet。导入余额的值 sheet 从第 5 行开始，A 列有一些文本描述每行值的含义，B 列和 D 列有每个项目的金额。

余额的每个部分和子部分的小计 sheet 位于 C 和 E 列。每个小计都位于上边框格式为实线的单元格中。

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

备注：

我没有使用 FindNext，因为它似乎忽略了前面 Find 方法中使用的格式设置，如 here 所述。
我尝试使用 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

我建议回到 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 2

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

例如：

Sub TestWhosebugCode()
    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 3

如果

，findNext 可能不起作用

在 [Set LookFor = WhereToLook.Find(...]

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

使用 .Find 方法的无限循环

Infinite loop with .Find method

format

excel

vba

find

infinite-loop