Question

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

资产负债表的每个部分和子部分的小计都在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

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

例如：

git add *.xml

Answer 3

如果

，findNext可能无效

[Set LookFor = WhereToLook.Find（...]

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

使用.Find方法的无限循环

3 个答案: