Excel VBA - 转置，复制和粘贴到不同的行，有条件

Question

我对 Excel 中的 VBA 完全陌生。

我的数据由 G 列（包含奖牌列表）和 H 列（代表国家/地区）组成。我想转置我的 NOC，使 J 列代表金牌，其余为其他奖牌（只要它们在同一行，顺序无关紧要是银牌还是铜牌）。请参考我下面的图片，这对我想要做什么是不言自明的。

我尝试编写 VBA 代码，以便它将列向下复制三并转置，但有很多次它没有通过三。有时有两枚铜牌，有时没有铜牌。

我认为它的工作方式是读取 G 列并沿着该列向下查找 Gold，如果找到“Gold”，那么我希望它转置下一列 H 的值，直到下一个 Gold 是在 G 列中找到。

下面由红色箭头指示的附图是我想要做的。

非常感谢您的帮助。

what i want to do

== 我设法在 stackoverflow 的帮助下解决了我的问题，这就是结果。

Public Sub RunSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' CONNECTION STRING
    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                  & "DBQ=C:\Path\To\Current\Workbook.xlsm;"
    ' SQL STATEMENT
    strSQL = "TRANSFORM MAX(m.NOC) AS CountryCode" _
        & " SELECT m.[Event], m.[Event Gender]" _
        & " FROM (SELECT t.[Event], t.[Event Gender], t.[Medal], t.NOC," _
        & "              (SELECT Count(*) FROM [MAIN$] sub" _
        & "               WHERE sub.[Event] = t.[Event]" _
        & "                 AND sub.[Event Gender] = t.[Event Gender]" _
        & "                 AND sub.[Medal] = t.[Medal]" _
        & "                 AND (IIF(sub.[Medal]='Gold', 1, IIF(sub.[Medal]='Silver', 2, 3)) <" _
        & "                      IIF(t.[Medal]='Gold', 1, IIF(t.[Medal]='Silver', 2, 3))" _
        & "                      OR sub.[NOC] <= t.[NOC])) AS rn" _
        & "       FROM [MAIN$] t) m" _
        & " GROUP BY m.[Event], m.[Event Gender]" _
        & " PIVOT m.[Medal] & m.[rn] IN" _
        & "       ('Gold1', 'Gold2', 'Gold3', 'Silver1', 'Silver2', 'Silver3'," _
        & "        'Bronze1', 'Bronze2', 'Bronze3')"

    ' OPEN DB CONN
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For i = 1 To rst.Fields.Count
        Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
    Next i        

    ' DATA ROWS
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    rst.Close: conn.Close    
End Sub

Answer 1

您可以通过算法来代替转置它：

'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
End With
MsgBox LastRow

'http://www.rondebruin.nl/win/s9/win005.htm

dim start as long
dim finish as long

for medal = 2 to lastrow
   if thisworkbook.worksheets("worksheetname").cells(medal,7).value = "gold" then
    start = medal
         for next_medal = medal+1 to lastrow
            if thisworkbook.worksheets("worksheetname").cells(next_medal,7).value = "gold"
                finish = next_medal -1 'because it should not copy the next gold in the previous row of J
                medal = next_medal-1'because it starts looking for the next gold the next round at -1

                'copy/assign the cells you want to transpose:
                for transposing = start to finish
                thisworkbook.worksheets("worksheetname").cells(2+counter,10+transposing-start).value = thisworkbook.worksheets("worksheetname").cells(transposing,7).value 'writing the rest of the medals to the right of the first gold medal
                next transposing
                counter = counter + 1'ensuring the next row in J will be filled next time.
            end if
         next next_medal
     end if
next medal

我的vba正在编译，所以我没有验证就写了，希望你理解这个想法:)

Answer 2

考虑一个专门用于运行crosstab query 的SQL 解决方案。 Excel for Windows 可以使用 ADO 连接到 Jet/ACE SQL 引擎（.dll 文件）并查询当前工作簿。

以下假设数据位于名为 Main 的选项卡中（如果需要，可更改查询的 FROM 子句），结果输出在名为 Results 的空选项卡中：

Public Sub RunSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' CONNECTION STRING
    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                      & "DBQ=C:\Path\To\Current\Workbook.xlsm;"
    ' SQL STATEMENT
    strSQL = "TRANSFORM MAX(m.NOC) AS CountryCode" _
            & " SELECT m.[Event], m.[Event Gender]" _
            & " FROM (SELECT t.[Event], t.[Event Gender], t.[Medal], t.NOC," _
            & "              (SELECT Count(*) FROM [MAIN$] sub" _
            & "               WHERE sub.[Event] = t.[Event]" _
            & "                 AND sub.[Event Gender] = t.[Event Gender]" _
            & "                 AND sub.[Medal] = t.[Medal]" _
            & "                 AND (IIF(sub.[Medal]='Gold', 1, IIF(sub.[Medal]='Silver', 2, 3)) <" _
            & "                      IIF(t.[Medal]='Gold', 1, IIF(t.[Medal]='Silver', 2, 3))" _
            & "                      OR sub.[NOC] <= t.[NOC])) AS rn" _
            & "       FROM [MAIN$] t) m" _
            & " GROUP BY m.[Event], m.[Event Gender]" _
            & " PIVOT m.[Medal] & m.[rn] IN" _
            & "       ('Gold1', 'Gold2', 'Gold3', 'Silver1', 'Silver2', 'Silver3'," _
            & "        'Bronze1', 'Bronze2', 'Bronze3')"

    ' OPEN DB CONN
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For i = 1 To rst.Fields.Count
        Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
    Next i        

    ' DATA ROWS
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    rst.Close: conn.Close    
End Sub

输入

输出