为每个dynamic范围创build小计行

所以我有这种XML格式的数据，我使用macros来使它看起来很花哨，并基于这组数据将其分解成dynamic范围。 我想要什么，不能为我的生活弄明白，是每个dynamic部分得到一个小计行。 当我写出来的时候，它就开始出现在我的面前，但是我不能正确地得到代码。 列将始终是B：H，每个部分都有一行，其中包含“材质”一词，而不包含其他任何内容。 下面是运行macros后我的数据如何的截图。

我想要的是在每个部分下面的蓝线，从C：G合并，在其中有小计，然后在H中的实际小计金额。可以有任何地方从1节太多。

这是我想要的样子。

我想我可以通过查找材料然后xlToRight和xlDown声明dynamic范围variables。 那么对于每一个可能？

我还在学习，所以非常感谢您的帮助！ 请让我知道，如果你需要我更多的信息！

UPDATE！

这是我迄今为止设法完成的。 但是，我在Rng = Range行出现错误“对象variables或块variables未设置”。

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> 

更新2/2/2017！

所以我越来越近了，我想。 我发现这个， 在Excel VBA中使用Find进行连续循环 ，并且能够变得非常接近。 不过，我要么陷入循环，要么就是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）将引发“无法获取Range类的FindNext属性”错误。 提前致谢！

Answer 1

所以我终于明白了。 感谢所有试图帮助！ 我还没有完全想到实际上得到小计的math部分，但我很接近，并将在我有更多的时间时工作。 现在，这已经得到了答复。 看下面的代码！

 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