Создание итоговой строки для каждого динамического диапазона

Question

Итак, у меня есть эти данные в формате XML, в которых я использую макрос, чтобы он выглядел все фантазии и разбивал его на динамические диапазоны на основе группы данных. То, что я хочу, и не могу, чтобы жизнь меня определяла, получает промежуточную строку для каждого динамического раздела. Он начинает приходить ко мне, когда я пишу это, но я просто не могу получить код правильно. Столбцы всегда будут B: H, и каждый раздел имеет строку, содержащую слово «Материалы» и ничего больше. Ниже приведен снимок экрана, как мои данные выглядят после запуска макроса.

То, что я хотел бы это не-boardered строки по каждому из этих разделов, синие, сливается с C: G, имеет слово подытог в нем, а затем фактическое количество субтотального в H. Там может быть от 1 до многих.

Вот что я хочу, чтобы он выглядел.

Я предполагаю, что могу объявить переменную динамического диапазона, ища слово Материалы затем xlToRight и xlDown. Тогда для каждого может быть?

Я все еще учась, поэтому ваша помощь очень ценится! Пожалуйста, дайте мне знать, если вам нужна дополнительная информация от меня!

ОБНОВЛЕНИЕ !!!

Вот что мне удалось собрать до сих пор. Тем не менее, я получаю сообщение об ошибке «Объектная переменная или с переменной блока не задано» в строке Rng = 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> 

ОБНОВЛЕНО 2/2/2017 !!!

Так что я становлюсь ближе, я думаю. Я нашел это, 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) бросает «Невозможно получить свойство FindNext из класса Range» ошибка. Заранее спасибо!

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