Question

我正在尝试将无人机坐标数据从XML转换为excel表，这涉及将三行坐标转换为一行。目前数据如下[[（）中所示的列字母：

(A)        (B)
Mark     Coordinate
1          -97.373773
1          124.34848
1          225
2          -97.746343
2          123.48343
2          225
3          -97.342533
3          123.23454
3          225

我想创建一个循环，复制每个“标记”数据的所有坐标和高程数据并将其粘贴到一行，如下所示：

(A)        (B)           (C)            (D)
1         -97.373773    124.34848       225
2         -97.746343    123.48343       225
3         -97.342533    123.23454       225

有人可以给我一些见解，了解如何创建一个循环，跳过A列中重复的“标记”数字，以便我可以将相关信息复制并粘贴到一行中吗？

提前干杯！

Answer 1

您可以使用MS Scripting Runtime Library中的Dictionary来完成此操作，将Mark作为键，将Collection作为值。要实例化一个：

Set dict = CreateObject("Scripting.Dictionary")

然后为其添加值：

If Not dict.Exists(yourMark) Then
    Dim newCollection As Collection
    Set newCollection = New Collection
    newCollection.Add(yourValue)

    dict.Add yourMark, newCollection
Else
    dict(yourMark).Add(yourValue)
End If

这样，只有在尚未看到的情况下才会添加新标记，并且所有值都将与该单个标记相关联。

您还可以使用dict.Item（mark）来获取与任何标记关联的Collection：

 Dim coordinates As Collection
 Set coordinates = dict.Item(mark)

你可以这样迭代字典：

For Each iterMark in dict.Keys
    Dim coordinates as Collection
    Set coordinates = dict.Item(iterMark)
Next

以下是Dictionary上的Microsoft支持文章。

如果由于某种原因不可能，还有一种方法可以以键值方式使用Collection。

Answer 2

这会将你的两个A：B列转移到D：G中的右边。

Sub xfer_coords()
    Dim a As Long, r As Long, rw As Long
    With ActiveSheet
        For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(r, 1).Value = a Then
                .Cells(rw, Columns.Count).End(xlToLeft).Offset(0, 1) = _
                  .Cells(r, 2).Value
            Else
                a = .Cells(r, 1).Value
                rw = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
                .Cells(rw, 4) = a
                .Cells(rw, 5) = .Cells(r, 2).Value
            End If
        Next r
    End With
End Sub

在VBA循环中跳过相等的数字

2 个答案: