Помогите с вложенным if / Loop VBA

Question

Я перебираю электронную таблицу Excel и объединяю все ячейки в строку, что я и сделал.Теперь мне нужно отформатировать строку с тегами XML, прежде чем я отправлю ее для загрузки, и у меня возникли некоторые трудности при правильной работе с тегами в цикле.Кажется, что это почти работает, но некоторые из тегов не в правильном месте.Любая помощь будет принята с благодарностью.

Код:

Public file As String

Sub locate_file()

Dim sheet1_95 As String
Dim theRange As Range
Dim strVal As String
Dim wb As Workbook
Dim counterDT As Integer
Dim counterSVR As Integer
Dim counterMB As Integer

Dim outputStr As String


'prompt user for location of other excel sheet'
file = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")

Set wb = Workbooks.Open(file)

Dim cell As Range

'initializing the xml string'
strVal = "<root>"

Sheets("DT").Activate

counterDT = 1

For Each cell In ActiveSheet.UsedRange.Cells
'this first if-block is just excluding the few header cells from the data collection'
  If cell.Value <> "SKU" And cell.Value <> "P Number" And cell.Value <> "Month" _
     And cell.Value <> "DP Dmd" And cell.Value <> "Vertical" Then
    If cell.Column = "1" Then
      strVal = strVal & "<item><sku>" & cell.Value & "</sku>"
    ElseIf cell.Column = "2" Then strVal = strVal & "<pnum>" & cell.Value & "</pnum>"
    ElseIf cell.Column = "3" Then strVal = strVal & "<month>" & cell.Value & "</month>"
    ElseIf cell.Column = "4" Then strVal = strVal & "<forecast>" & cell.Value & "</forecast>"
    Else: strVal = strVal & "<vertical>" & cell.Value & "</vertical>"
    End If

    counterDT = counterDT + 1

    If cell.Row <> 1 Then
      If counterDT Mod 6 = 0 Then
        strVal = "<item>" & strVal & "<percent>" & category.percent(cell, "DT") & "</percent>"
       Else: End If
    Else: End If
  End If
Next

strVal = strVal & "</root>"

Таким образом, в основном проблема заключается в том, что этот цикл / вложенный, если печатает как 30 тегов "item" в самом начале строкии я не уверен почему.

Для некоторой другой информации, лист Excel состоит из 6 столбцов и всегда будет 6.

Answer 1

Когда я создаю теги xml, мне нравится перемещать фактические теги в отдельную функцию. Плюс в том, что он обеспечивает соответствие моих тегов. Недостатком является то, что вы не «применяете» теги до конца. Теги, такие как item и root, создаются после того, как все теги внутри них сделаны. Вот пример:

Sub locate_file()

    Dim sVal As String
    Dim sRow As String
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim lCntDT As Long
    Dim rCell As Range
    Dim rRow As Range
    Dim vaTags As Variant

    gsFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")

    If gsFile <> "False" Then
        Set wb = Workbooks.Open(gsFile)
        Set sh = wb.Sheets("DT")
        vaTags = Array("sku", "pnum", "month", "forecast", "vertical")

        lCntDT = 1

        For Each rRow In sh.UsedRange.EntireRow
            sRow = ""
            If rRow.Cells(1) <> "SKU" Then
                For Each rCell In Intersect(sh.UsedRange, rRow).Cells
                    If rCell.Column <= 4 Then
                        sRow = sRow & TagValue(rCell.Value, vaTags(rCell.Column - 1))
                    Else
                        sRow = sRow & TagValue(rCell.Value, vaTags(UBound(vaTags)))
                    End If
                Next rCell

                lCntDT = lCntDT + 1
                If rRow.Row <> 1 And lCntDT Mod 6 = 0 Then
                    sVal = sVal & TagValue("CatPct", "percent")
                End If
                sRow = TagValue(sRow, "item")
                sVal = sVal & sRow & vbNewLine
            End If
        Next rRow
        sVal = TagValue(sVal, "root")
    End If

    Debug.Print sVal

End Sub

Function TagValue(ByVal sValue As String, ByVal sTag As String) As String

    TagValue = "<" & sTag & ">" & sValue & "</" & sTag & ">"

End Function