Question

我是excel的VBA新手。

我的数据包括G列，奖牌列表和列H，代表国家。我想转换我的NOC，以便J列代表Gold，其余的是其他奖牌（只要它们在同一行，顺序无论是银色还是青铜色）。请参考下面的图片，对我想做的事情不言自明。

我尝试对VBA进行编码，以便它可以复制三列并进行转置，但有很多时候它不会三次。有时候有两枚铜牌，有时候没有铜牌。

我认为它可以工作的是读取G列然后沿着列向下查找Gold，如果找到“Gold”，那么我希望它转换下一列H的值，直到下一个Gold为见G列。

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

我非常感谢你的帮助。

== 我设法通过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

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

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

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

<强>输入

<强>输出

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

2 个答案: