为每个动态范围创建小计行答案

【问题标题】：Create Subtotal Row for Each Dynamic Range为每个动态范围创建小计行
【发布时间】：2017-06-04 14:12:42
【问题描述】：

所以我有这些 XML 格式的数据，我使用宏使它看起来很花哨，并根据数据组将其分解为动态范围。我想要并且无法为我的生活弄清楚的是，为每个动态部分获取一个小计行。当我写出来时，它开始出现在我身上，但我就是无法正确编写代码。列将始终为 B:H，并且每个部分都有一行包含“材料”一词，没有其他内容。下面是我运行宏后数据的截图。

我想要的是在每个蓝色部分下的非边界行，从 C:G 合并，里面有小计这个词，然后是 H 中的实际小计金额。可以有任何地方从 1 个部分到多个部分。

这就是我想要的样子。

我想我可以通过查找单词 Materials 然后是 xlToRight 和 xlDown 来声明动态范围变量。然后可能是 For Each？

我还在学习，非常感谢您的帮助！如果您需要我提供更多信息，请告诉我！

更新！！！

到目前为止，这是我设法整理的内容。但是，我在 theRng = Range 行上收到错误消息“对象变量或未设置块变量”。

theWord = Cells.Find(What:="Materials", After:=ActiveCell, _   
LookIn:+xlFormulas, LookAt _                    
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Selection.End(xlDown).Offset(1, 1).Select
theRng = Range(Selection, Selection.Offset(0, 4)).Select

For Each Item In theRng
    Item.Select
        With Selection
            .MergeCells = True
            .Font.Size = 14
            .Font.Color = vbWhite
            .Font.Bold = True
            .Interior.Color = RGB(0, 51, 204)
            .Value = "Materials"
        End With
Next

更新！！！

这是我在 Excel 中打开数据后通常的样子。

更新！！！

这是 XML 数据。很抱歉！

<?xml version="1.0" encoding="UTF-8" ?>
<Quote>
<Group>
<GroupLabel>Access Points</GroupLabel>
<LineItem>
<LineNumber>1.00</LineNumber>
<PartNumber>JX946A</PartNumber>
<Description>Aruba IAP-305 (US) 802.11n/ac Dual 2x2:2/3x3:3 MU-MIMO Radio Integrated Antenna Instant AP</Description>
<Manufacturer>Hewlett Packard Enterprise</Manufacturer>
<UnitPrice>$695.00</UnitPrice>
<Quantity>165</Quantity>
<Total>$114,675.00</Total>
<PriceList>USA Price List (USD)</PriceList>
<Status>Proposed</Status>
</LineItem>
<LineItem>
<LineNumber>2.00</LineNumber>
<PartNumber>H5DW1E</PartNumber>
<Description>Aruba 1Y FC NBD Exch IAP 305 SVC  [for JX946A]</Description>
<Manufacturer>Hewlett Packard Enterprise</Manufacturer>
<UnitPrice>$31.00</UnitPrice>
<Quantity>165</Quantity>
<Total>$5,115.00</Total>
<PriceList>USA Price List (USD)</PriceList>
<Status>Proposed</Status>
</LineItem>
<LineItem>
<LineNumber>3.00</LineNumber>
<PartNumber>JW327A</PartNumber>
<Description>Aruba Instant IAP-325 (US) 802.11n/ac Dual 4x4:4 MU-MIMO Radio   Integrated Antenna AP</Description>
<Manufacturer>Hewlett Packard Enterprise</Manufacturer>
<UnitPrice>$1,395.00</UnitPrice>
<Quantity>10</Quantity>
<Total>$13,950.00</Total>
<PriceList>USA Price List (USD)</PriceList>
<Status>Proposed</Status>
</LineItem>
<LineItem>
<LineNumber>4.00</LineNumber>
<PartNumber>H4DN5E</PartNumber>
<Description>Aruba 1Y FC NBD Exch IAP 325 SVC  [for JW327A]</Description>
<Manufacturer>Hewlett Packard Enterprise</Manufacturer>
<UnitPrice>$61.00</UnitPrice>
<Quantity>10</Quantity>
<Total>$610.00</Total>
<PriceList>USA Price List (USD)</PriceList>
<Status>Proposed</Status>
</LineItem>
</Group>
</Quote>

2017 年 2 月 2 日更新！！！

所以我想我越来越近了。我发现了这个，continuous loop using Find in Excel VBA，并且能够非常接近。但是，我要么陷入循环，要么在 FindNext 上出错。我不知道还能做什么！请帮忙！

Option Explicit
Sub Testing()

Dim wsI As Worksheet
Dim lRow As Long, i As Long
Dim theWrd As Range, theWrd1 As Range
Dim theRng As Range
Dim theB As Range
Dim srchWrd As String

Application.ScreenUpdating = False

lRow = Range("B" & Rows.Count).End(xlUp).Row

For i = 12 To lRow
    Set theWrd = Columns(2).Find(What:="Materials", LookIn:=xlValues, _
                 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _
                 :=xlNext, MatchCase:=False, SearchFormat:=False) _
                 .End(xlDown).Offset(1, 1)

    If Not theWrd Is Nothing Then
        Range(theWrd, theWrd.Offset(0, 4)).Interior.Color = RGB(149, 179,    215)
        Do
            Set theWrd = Columns(2).FindNext(theWrd)
            If Not theWrd Is Nothing Then
                 Range(theWrd, theWrd.Offset(0, 4)).Interior.Color = vbBlack
                    Else
                        Exit Do
                    End If
                Loop
        End If
    Next i    
End Sub

第 2 列 (2) 引发“无法获取 Range 类的 FindNext 属性”错误。提前致谢！

【问题讨论】：

XML 是一种 OpenXML 格式吗？还是您根据地图模式读入 Excel 的常规 XML？请发布其内容的几个节点（包括根）。
@Parfait 我什至不应该提到它最初是 XML 数据。但自从我做到了！ :) 我将数据作为表格导入。然后我删除表格格式并将其转换为宏内部的范围。
我将数据作为表格导入...什么是表格？请用一些东西来限定它：HTML 表、数据库表等。导入的内容是什么具体格式？
当我在 Excel 中打开 XML 文件时，它给了我 3 个选项。 1) 作为 XML 表打开。 2) 作为只读工作簿打开。 3)使用 XML Source 任务窗格。
托德，我怀疑@Parfait 试图建议可以通过 VBA 解析 XML，并使用 DOM、XPath、XSLT 或 SAX 的一些技术将其转换为输出结构。您确实需要显示 XML！ etc. 然后可以系统地转化为所需的二维输出。

标签： xml vba excel range

【解决方案1】：

所以我终于想通了。感谢所有试图提供帮助的人！我还没有完全弄清楚要真正完成数学小计部分，但我已经很接近了，当我有更多时间时会继续努力。目前，这个问题已经得到解答。请看下面的代码！

Sub findMaterials_SMS()

Dim cRange As Range, cFound As Range
Dim cFound2 As Range
Dim firstAddress As String

Set cRange = Columns(2).Find(What:="Materials", LookIn:=xlValues, _
         LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _
         :=xlNext, MatchCase:=False, SearchFormat:=False)
If Not cRange Is Nothing Then
firstAddress = cRange.Address
Do
    Set cFound = cRange.End(xlDown).Offset(1, 2)
    Set cFound2 = Range(cFound, cFound.Offset(0, 5))
    With cFound2
        .Interior.Color = RGB(149, 179, 215)
        .Font.Color = vbWhite
        .Font.Bold = True
        .Font.Size = 11
    End With
    With cFound2.Offset(0, -1)
        .MergeCells = True
        .HorizontalAlignment = xlRight
    End With
    Set cRange = Columns(2).FindNext(cRange)
Loop While cRange.Address <> firstAddress
End If

End Sub

【讨论】：