Excel VBA - Transponieren, Kopieren und Einfügen in verschiedenen Zeilen, mit Bedingungen

Question

Ich bin völlig neu in VBA in Excel.

Meine Daten bestehen aus Spalte G, mit einer Liste von Medaillen, und Spalte H, die Nationen darstellt. Ich möchte meine NOCs so transponieren, dass die J-Spalte für Gold steht und der Rest für andere Medaillen (die Reihenfolge spielt keine Rolle, ob es sich um Silber oder Bronze handelt, solange sie sich in derselben Reihe befinden). Bitte beachten Sie mein Bild unten, es wäre selbsterklärend, was ich tun möchte.

Ich habe versucht, VBA zu kodieren, so dass es drei-down die Spalte kopieren und transponieren würde, aber es gibt zahlreiche Male, wenn es nicht um drei geht. Manchmal gibt es zwei Bronzemedaillen und manchmal keine Bronzemedaille.

Wie ich dachte, es könnte funktionieren, lesen Sie Spalte G und gehen Sie die Spalte und suchen Sie nach Gold, und wenn "Gold" gefunden wird, dann soll es den Wert der nächsten Spalte H bis zum nächsten Gold transponieren ist in der Spalte G.

Angehängte Bild unten durch rote Pfeile gerichtet ist, was ich tun möchte.

Ich würde Ihre Hilfe sehr schätzen.

what i want to do

== konnte ich mein Problem mit Hilfe von Stackoverflow lösen, und das ist das Ergebnis.

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

Statt es zu transponieren, können Sie es algorithmisch tun:

'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 

Mein vba wurde Kompilieren so schrieb ich es ohne Überprüfung, ich hoffe, dass Sie die Idee begreifen :)

Answer 2

Betrachten eine SQL-Lösung speziell wo Sie die crosstab query ausführen. Excel für Windows kann eine Verbindung mit der Jet/ACE SQL Engine (DLL-Dateien) mit ADO herstellen und die aktuelle Arbeitsmappe abfragen.

Im Folgenden wird davon ausgegangen Daten befinden sich in einem Tab namens Haupt (Änderung der FROM Klausel der Abfrage, wenn erforderlich) und Ergebnisausgabe in einem leeren Tab namens Ergebnisse:

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 

Eingang

Ausg ut