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

时间:2017-01-19 18:35:53

标签: xml excel vba excel-vba range

所以我有XML格式的数据,我使用宏来使它看起来很奇特,并根据数据组将其分解为动态范围。我想要的,不能为我的生活弄清楚,是为每个动态部分得到一个小计行。当我写出来时,它开始向我发起,但我无法正确地获得代码。列将始终为B:H,每个部分都有一行包含“材料”一词,而不包含任何其他内容。 下面是我运行宏后数据的样子截图。 enter image description here

我想要的是在每个部分下面的非划线行,蓝色,从C:G合并,在其中包含单词小计,然后在H中实际小计数量。可以有任何地方从1节到很多节。

这就是我想要它的样子。 enter image description here

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

我还在学习,所以非常感谢你的帮助!如果您需要我的更多信息,请告诉我们!

UPDATE !!!

到目前为止,这是我设法汇总的内容。但是,我在theRng = Range行上收到错误“Object variable或With block variable not set”。

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中打开数据后通常会看到的数据。

data before macro

已更新!

这是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)抛出'无法获取Range类的FindNext属性'错误。提前谢谢!

1 个答案:

答案 0 :(得分:0)

所以我终于明白了。感谢所有试图帮助的人!我仍然没有想到要实际完成小计数学部分但是我很接近并且当我有更多时间时会继续工作。目前,这已得到回答。请参阅下面的代码!

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