各ダイナミックレンジの小計行を作成する

Question

このデータはXML形式で保存されていますので、マクロを使用して見た目をよくし、データグループに基づいてダイナミックレンジに分割します。私が欲しいのは、私の人生のためには分かりませんが、各動的セクションの小計の行が得られます。私はこれを書いているので、私に来て始めているが、私はちょうどコードを得ることができない。列は常にB：Hになり、各セクションには「マテリアル」という単語とそれ以外の単語が含まれている行があります。 以下は、マクロを実行した後の私のデータの様子のスクリーンショットです。

私が望むのは、青色で、C：Gからマージされ、小計という単語があり、次に実際の小計の総数がHの各セクションの下に置かれていない行です。 1つのセクションから多くのものにすることができます。

私はそれが私のように見えるようにしたいです。

xlToRightとxlDownという単語を探してダイナミックレンジ変数を宣言できたと思います。その後、それぞれのために？

私はまだあなたの助けを非常に感謝して学習している！私の詳細情報が必要な場合はお知らせください！

UPDATE !!!

これまでにまとめたことはありますか。しかし、私は、エラー "オブジェクト変数またはWithブロック変数が設定されていない" 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 

UPDATED !!!

ここでは、データを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> 

UPDATED 2/2/2017！

私は近づいていると思います。私はこれを見つけました、continuous loop using Find in Excel VBA、かなり近づくことができました。しかし、私はループで立ち往生したり、FindNextでエラーが発生する。他に何をすべきかわからない！助けてください！

2番目の列（2）が「RangeクラスのFindNextプロパティを取得できません」というエラーをスローします。前もって感謝します！

Answer 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