將列值轉換為行值

Question

我想使用excel 2010 VBA實現一個將值從列轉移到行的函數，如果同一行中有10個以上的值，則第11個值將返回第二行。

例如：

=========

ColA  ColB
1111  AAA
1111  BBB
1111  CCC
1111  DDD
1111  EEE
1111  FFF
1111  GGG
1111  HHH
1111  III
1111  JJJ
1111  KKK
1111  LLL
2222  MMM
2222  OOO
2222  PPP

期望：

ColA   Val1   Val2   Val3    Val4   Val5   Val6   Val7    Val8    Val9    Val10 
1111   AAA    BBB    CCC    DDD     EEE    FFF    GGG     HHHH    III     JJJ
1111   KKK    LLL  
2222   MMM    OOO    PPP 

=========

我試圖先用定界符“，”將值分組到一個字段中，然后使用excel函數將數據分為不同的列。 這是將值分組的代碼，但如果有10個以上的值，我不知道如何告訴excel去第二行。

這是將值分組的代碼：

 Sub combineValues()
    Dim dic As Dictionary
     Dim key, val, i, p, k
    Set dic = New Dictionary
    For i = 1 To Worksheets(1).Range("A65536").End(xlUp).Row
        key = Worksheets(1).Cells(i, 1).Value
        val = Worksheets(1).Cells(i, 2).Value
        If dic.Exists(key) Then
            dic.Item(key) = dic.Item(key) & ", " & val
        Else
            dic.Add key, val
        End If
    Next
    p = 1
    For Each k In dic.Keys
        Worksheets(2).Cells(p, 1) = k
        Worksheets(2).Cells(p, 2) = dic.Item(k)
        p = p + 1
    Next
End Sub

使用代碼，我可以將值分組為一行，如下所示：

ColA  ColB
1111  AAA,BBB,CCC,DDD,EEE,FFF,GGG,HHH,III,JJJ,KKK,LLL
2222  MMM,OOO,PPP

然后我使用excel函數將所有這些值分成不同的字段，主要是這樣的：

ColA   Val1   Val2   Val3   Val4   Val5   Val6   Val7   Val8   Val9    Val10 Val11 Val12 
1111   AAA    BBB    CCC    DDD     EEE    FFF    GGG    HHH    III     JJJ  KKK    LLL  
2222   MMM    OOO    PPP 

但是問題是我不想在同一行中出現超過10個值，我想知道是否有10個以上的值，它返回到第二行以顯示其余值。

Answer 1

好的，這是我的第二次嘗試：

Sub test2()
    Dim search As Long
    Dim j As Long
    Dim l As Long
    Dim cCount As Long
    Dim aCount As Long

    aCount = 1

    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        l = 2
        j = i
        cCount = 0

        search = Cells(i, 1).Value
        Worksheets("test").Cells(aCount, 1).Value = Cells(i, 1).Value
        While search = Cells(j, 1).Value
            If l = 12 Then
                aCount = aCount + 1
                Worksheets("test").Cells(aCount, 1).Value = Cells(i, 1).Value
                l = 2
            Else
             Worksheets("test").Cells(aCount, l).Value = Cells(j, 2).Value
                j = j + 1
                l = l + 1
                cCount = cCount + 1
            End If
        Wend
        aCount = aCount + 1
        i = i + cCount - 1
    Next i
End Sub

這次您輸入以下內容：

並得到這個：

這次它將檢查ColA的值，只要ColA的值相同，它將把ColB的值放在右邊的下一列中，每隔10列就有一個間隔。

最好的問候安妮

也許我的英語不夠好，無法理解問題，但這不是您想要的結果嗎？

之前：

后：