Question

Excel中的两列，列出了候选ID和首选城市（只是其中的一部分）：

  A       B
6957    Ankara
6957    Antalya
6957    İstanbul
6957    İzmir
8469    İstanbul
8470    İzmir
8470    İstanbul
8499    İstanbul
8514    İstanbul
7775    Ankara
7775    Eskişehir
7775    Kastamonu
7775    Zonguldak
7775    Karabük
8532    Ankara
8532    Antalya
8532    Bursa
8532    İzmir

如何使用VBA使它们看起来如下所示：

 A         B         C          D         E          F
6957    Ankara     Antalya   İstanbul   İzmir
8469    İstanbul                
8470    İzmir      İstanbul             
8499    İstanbul        
8514    İstanbul                
7775    Ankara    Eskişehir  Kastamonu  Zonguldak   Karabük
8532    Ankara    Antalya    Bursa      İzmir

Answer 1

您可以尝试以下VBA宏 - 它对我有用，可以使用以上数据：

Sub makeTable()
Dim inRange As Range
Dim outRange As Range
Dim currentCell, currentCandidate
Dim optionCount As Integer

Set inRange = Range("A2:A19")
Set outRange = Range("D2")

currentCandidate = inRange.Cells(1).Value
outRange.Value = currentCandidate
optionCount = 0

For Each currentCell In inRange.Cells
  If currentCell.Value = currentCandidate Then
    optionCount = optionCount + 1
  Else
    optionCount = 1
    Set outRange = outRange.Offset(1, 0)
    currentCandidate = currentCell.Value
    outRange.Value = currentCandidate
  End If
  outRange.Offset(0, optionCount) = currentCell.Offset(0, 1)

Next currentCell

End Sub

输出：

enter image description here

注意 - 这确实要求您对数据进行排序（首先是候选人，然后按城市排序），但我认为您已经完成了这项工作。

Answer 2

这是另一个建议。它将工作分为两个步骤：

将数据带入新结构。
将新结构写入Excel。

有时分离工作环境很有价值。与Floris的代码段不同，不必订购关键列。

（算法于06/25/14 20:30根据评论编辑。）

Dim rIn As Range
Dim rOut As Range

Dim row As Range
Dim key
Dim value
Dim keyString As String

Dim resultCollection As Collection
Dim resultRow As Collection
Dim rowOffset As Integer
Dim columnOffset As Integer
Dim outItem

Set rIn = Range("A1:B9")
Set rOut = Range("C1")
Set resultCollection = New Collection

' 1. Loop through all rows of the input range.
For Each row In rIn.Rows

    key = row.Cells(1, 1)
    value = row.Cells(1, 2)

    keyString = CStr(key)

    ' VBA Collections cannot check if a key exists. Error checking is the way to go.
    ' Error 457 is to bear in mind: "This key is already associated with an element of this collection."
    On Error Resume Next 

    ' Try to add a new key and its collection.
    resultCollection.Add New Collection, keyString
    If Err.Number = 0 Then
        ' No error means that key has just been added. Init the entry.
        resultCollection(keyString).Add keyString
    End If
    ' Here, enhanced error handling is possible.
    Err.Clear
    On Error GoTo 0

    ' Here we are sure that the result collection was prepared with the right key and a collection.
    resultCollection(keyString).Add value

Next

' 2. Write the prepared resultCollectionto the sheet.
rowOffset = 0
For Each resultRow In resultCollection
    columnOffset = 0
    For Each outItem In resultRow
        rOut.Offset(rowOffset, columnOffset).value = outItem
        columnOffset = columnOffset + 1
    Next
    rowOffset = rowOffset + 1
Next

注：

每当您必须使用VBA错误处理时，因为无法检测到前面的情况，您可以选择以下选项：

转移到错误处理程序并设置一些将在主程序流中使用的变量。
使用On Error Resume Next和err.Number以及err.Clear。

两种选择都可能导致代码难以理解，这取决于具体情况。选项1更短。此外，我不喜欢“副作用”。由主流程外的错误处理程序精心设置的主程序流程中的变量提醒我副作用。

在使用数组而不是集合时，您可以将数组直接指定给范围，并在第2部分中保留内部循环。

VBA - 区分值并将数据转置到它们旁边的最佳方法？

2 个答案: