Question

我需要将XML文件重新格式化为.CSV。我已经在Excel中打开了XML并进行了一些格式化，但现在我真的需要编写一个宏来使数据成形。我已经开始了，我的循环逻辑确实存在问题。

列表中有几千篇文章，其中包含可变数量的子文章。每个子粒子作为相同数量的属性但不是每篇文章都具有相同的属性。

https://picload.org/image/ipialic/now.jpg

https://picload.org/image/ipialip/then.jpg

到目前为止我的代码看起来像这样：

    Option Explicit
Dim rowCount As Long, articleCount As Long, propertyCount As Integer, name As String

Sub Sortfunction()
rowCount = 1
articleCount = 0
propertyCount = 0

Do While Sheets("Test").Cells(rowCount, 1).Value <> "end"

    If Cells(rowCount, 1).Value = "Reference" Then
        rowCount = rowCount + 1

        Do While Cells(rowCount, 3).Value = ""
            If Cells(rowCount, 3).Value = "4" Then

            End If
        articleCount = articleCount + 1
        Loop

        articleCount = articleCount + 1
    End If
rowCount = rowCount + 1
Loop

Sheets("result").Cells(1, 1).Value = rowCount
Sheets("result").Cells(2, 1).Value = articleCount

End Sub

在文档的最后，我写了“结束”，以便有一个钩子来停止循环。

有人可以提供一些帮助吗？我真的不是最好的程序员： - / 我真的很感激我能得到的任何帮助： - ）

Answer 1

这里他是算法的翻译和一些功能提示

更新：它比我想象的更棘手......我不得不重写代码。主要问题是“如何决定何时更改列”。

我选择此解决方案“参考中的每个产品必须具有相同数量的属性”。

如果情况并非如此，请说明“您何时决定何时创建新列”（您可以用简单的词语解释）

这里代码重写了。我在你的例子上尝试了它，它工作

Public Sub test()
    ' Set the range to navigate in your first sheet
    Dim cell As Range: Set cell = Sheets("Feuil1").Range("A1")

    ' set the range to navigate in your result sheet
    Dim res As Range: Set res = Nothing
    ' pos will be used to know the position of a product
    Dim lastProperties As Range, posProperties As Range

    ' While the cell value is not "end"
    Do While cell <> "end"

        ' if the cell is a reference
        If cell = "Reference" Then
            ' Set the range of res
            If res Is Nothing Then
                Set res = Sheets("Feuil2").Range("A1")
            Else
                Set res = Sheets("Feuil2").Range("A" & lastProperties.offset(2).Row)
            End If
            ' I set Offset(2) so you will have an empty line between 2 references

            ' Set the text of the new reference in the result
            res = cell.offset(, 1)    ' The reference is the cell 1 offset the right of the cell "Reference"
            ' WARNING : here no writing of titles anymore. It'll be done in the "Else".
            ' Here you just write "new reference" and reinit var
        Else
            ' Here we have a property
            ' If the property alreay exist, consider it a new product in the reference
            ' When we are on a new property, the column of the product if the next to the right
            If GetProperties(cell.offset(, 3), res, posProperties) Then
                Set lastProperties = posProperties
            End If

            posProperties = cell.offset(, 4)
        End If

        ' BIG FORGET: you have to get the next cell
        Set cell = cell.offset(1)
    Loop
End Sub

以及搜索/创建属性的功能

Private Function GetProperties(ByVal propValues As String, ByVal start As Range, ByRef position As Range) As Boolean
    Set position = start.offset(1)

    ' Is the cell below the properties ? Return the row below
    ' Search for the first "empty row" on the line
    If position = propValues Then
        Do
            Set position = position.offset(, 1)
        Loop While Trim(position) <> ""

        ' Indicate it's an existing value
        GetProperties = True
        Exit Function
    End If

    ' Is the range empty ?
    If Trim(position) = "" Then
        ' Create the new properties
        position = propValues
        Set position = position.offset(, 1)
        GetProperties = False
        Exit Function
    End If

    ' Search the properties in the row below
    GetProperties = GetProperties(propValues, position, position)
End Function

它应该做的工作。如果您对某些部分有任何疑问，请不要犹豫

如果您不知道Offset，请阅读：https://msdn.microsoft.com/en-us/library/office/ff840060.aspx

VBA makro将Excel中的XML格式化为CSV格式

1 个答案: