Zum Inhalt springen

[VB]Excel Sortieren mehrerer Spalten

Majestix

Von Majestix
in Basic

 Teilen

Empfohlene Beiträge

Majestix

Majestix

Geschrieben
Geschrieben

Servus leute,

ich hoff mal der Basic berreich ist das richtige Forum. Folgendes Problem:

Ein Excel File mit 29 Spalte( A -> AC ) und 2 bis 9999 Rows (variert). Alle Daten befinden sich auf einem Sheet und es kann vorkommen das manche der Spalten "hide" sind. In dem Sheet befinden sich Daten vom Format Integer, Strings und Date. (die erste row beinhaltet überschriften, keine daten)

Das ganze Sheet soll nun asce sortiert werden, unter berückstigung ALLER spalten ! die excel sort funktion selber bietet nur ein sortierung in einbeziehen 3er Spalten ich brauch aber wie gesagt 29.....

ich habe bereits folgendes macro versucht:


Range("A1:AC9999").Sort 

Key1 :=Range("A2"),  Order1 :=xlAscending, _ 

Key2 :=Range("B2"),  Order2 :=xlAscending, _

Key3 :=Range("C2"),  Order3 :=xlAscending, _

Key4 :=Range("D2"),  Order4 :=xlAscending, _ 

Key5 :=Range("E2"),  Order5 :=xlAscending, _ 

Key6 :=Range("F2"),  Order6 :=xlAscending, _ 

Key7 :=Range("G2"),  Order7 :=xlAscending, _ 

Key8 :=Range("H2"),  Order8 :=xlAscending, _ 

Key9 :=Range("I2"),  Order9 :=xlAscending, _ 

Key10:=Range("J2"),  Order10:=xlAscending, _ 

Key11:=Range("K2"),  Order11:=xlAscending, _ 

Key12:=Range("L2"),  Order12:=xlAscending, _ 

Key13:=Range("M2"),  Order13:=xlAscending, _ 

Key14:=Range("N2"),  Order14:=xlAscending, _ 

Key15:=Range("O2"),  Order15:=xlAscending, _ 

Key16:=Range("P2"),  Order16:=xlAscending, _ 

Key17:=Range("Q2"),  Order17:=xlAscending, _ 

Key18:=Range("R2"),  Order18:=xlAscending, _ 

Key19:=Range("S2"),  Order19:=xlAscending, _ 

Key20:=Range("T2"),  Order20:=xlAscending, _ 

Key21:=Range("U2"),  Order21:=xlAscending, _ 

Key22:=Range("V2"),  Order22:=xlAscending, _ 

Key23:=Range("W2"),  Order23:=xlAscending, _ 

Key24:=Range("X2"),  Order24:=xlAscending, _ 

Key25:=Range("Y2"),  Order25:=xlAscending, _ 

Key26:=Range("Z2"),  Order26:=xlAscending, _ 

Key27:=Range("AA2"), Order27:=xlAscending, _ 

Key28:=Range("AB2"), Order28:=xlAscending, _ 

Key29:=Range("AC2"), Order29:=xlAscending, _ 

Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _

xlTopToBottom, _

DataOption1 :=xlSortNormal, _

DataOption2 :=xlSortNormal, _

DataOption3 :=xlSortNormal, _

DataOption4 :=xlSortNormal, _

DataOption5 :=xlSortNormal, _

DataOption6 :=xlSortNormal, _

DataOption7 :=xlSortNormal, _

DataOption8 :=xlSortNormal, _

DataOption9 :=xlSortNormal, _

DataOption10:=xlSortNormal, _

DataOption11:=xlSortNormal, _

DataOption12:=xlSortNormal, _

DataOption13:=xlSortNormal, _

DataOption14:=xlSortNormal, _

DataOption15:=xlSortNormal, _

DataOption16:=xlSortNormal, _

DataOption17:=xlSortNormal, _

DataOption18:=xlSortNormal, _

DataOption19:=xlSortNormal, _

DataOption20:=xlSortNormal, _

DataOption21:=xlSortNormal, _

DataOption22:=xlSortNormal, _

DataOption23:=xlSortNormal, _

DataOption24:=xlSortNormal, _

DataOption25:=xlSortNormal, _

DataOption26:=xlSortNormal, _

DataOption27:=xlSortNormal, _

DataOption28:=xlSortNormal, _

DataOption29:=xlSortNormal

hierbei kommt aber die Fehlermeldung:

"Too many line continuations"

laut der excel hilfe soll ich das ganze in mehrer functionen splitten .. wobei mir aber noch nicht ganz klar ist wie ich das machen soll, während der sortier algorythmus richtig bleibt.

jemand eine idee ?

danke vorab !

Link zu diesem Kommentar
Auf anderen Seiten teilen
Majestix

Majestix

Geschrieben
  • Autor
Geschrieben

hier eine lösung:


' **************************************************************

'  Modul:  Modul1  Typ = Allgemeines Modul

' **************************************************************


Option Explicit


Public Sub prcTest()

    Dim intColumn As Integer

    Dim lngRow As Long

    Dim vntArray(2 To 10000, 1 To 29) As Variant

    Dim vntSortArray As Variant


    'die zu sortierenden Spalten

    'negative Zahl = Spalte absteigend sortieren

    'positive Zahl = Spalte aufsteigend sortieren

    vntSortArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29)


    For lngRow = 2 To 10000

        For intColumn = 1 To 29

        If Not ActiveSheet.Cells(lngRow, intColumn).Value = "" Then

            vntArray(lngRow, intColumn) = ActiveSheet.Cells(lngRow, intColumn).Value

        End If

        Next

    Next



    'Sortierroutine starten


    Call prcSort(vntSortArray, vntArray())


    'Ausgabe Testarray

    Application.ScreenUpdating = False

    Range("A2:AD10000").Value = vntArray


    Dim vEmpty As Boolean

    vEmpty = False


    For lngRow = 2 To 10000

        For intColumn = 1 To 29

        If Not ActiveSheet.Cells(lngRow, intColumn).Value = "" Then

           vEmpty = True

           Exit For

        End If

        Next

        If Not vEmpty Then

         Rows(lngRow).Delete

        End If

        vEmpty = False

    Next

    Application.ScreenUpdating = True

End Sub


Private Sub prcSort(vntSortArray As Variant, vntArray() As Variant)

    Dim intIndex As Integer

    Dim lngIndex1 As Long, lngIndex2 As Long, lngRowsArray() As Long

    Dim lngRowsCount As Long, lngRangeCount As Long

    Dim vntTemp As Variant

    ReDim lngRowsArray(0 To 1, 0 To UBound(vntArray) * 2)


    'Array für den 1. Sortierlauf

    lngRowsArray(0, 0) = LBound(vntArray)

    lngRowsArray(0, 1) = UBound(vntArray)

    lngRowsCount = 1


    For intIndex = LBound(vntSortArray) To UBound(vntSortArray)


        'Wenn eine Spalte angegeben

        If vntSortArray(intIndex) <> 0 Then

            lngRangeCount = -1


            'Schleife zum sortieren der einzelnen Bereiche

            For lngIndex1 = 0 To lngRowsCount Step 2


                'Sortieren des Bereichs, wenn Zeilenzahl größer 1

                If lngRowsArray(0, lngIndex1) <> lngRowsArray(0, lngIndex1 + 1) Then


                    Call prcQuickSort(CLng(lngRowsArray(0, lngIndex1)), _

                        CLng(lngRowsArray(0, lngIndex1 + 1)), CInt(Abs(vntSortArray(intIndex))), _

                        CBool(vntSortArray(intIndex) > 0), vntArray())


                    'sortierten Bereich merken

                    lngRangeCount = lngRangeCount + 2

                    lngRowsArray(1, lngRangeCount - 1) = lngRowsArray(0, lngIndex1)

                    lngRowsArray(1, lngRangeCount) = lngRowsArray(0, lngIndex1 + 1)


                End If

            Next


            lngRowsCount = -1


            'Durchsuchen der soeben sortierten Spalte nach Wertewechsel

            For lngIndex1 = 0 To lngRangeCount Step 2


                '1. Zeile des zu sortierenden Bereichs

                vntTemp = vntArray(lngRowsArray(1, lngIndex1), Abs(vntSortArray(intIndex)))

                lngRowsCount = lngRowsCount + 1

                lngRowsArray(0, lngRowsCount) = lngRowsArray(1, lngIndex1)


                'Suche nach Wechsel innerhalb des Bereichs

                For lngIndex2 = lngRowsArray(1, lngIndex1) To lngRowsArray(1, lngIndex1 + 1)

                    If vntTemp <> vntArray(lngIndex2, Abs(vntSortArray(intIndex))) Then

                        lngRowsCount = lngRowsCount + 2

                        lngRowsArray(0, lngRowsCount - 1) = lngIndex2 - 1

                        lngRowsArray(0, lngRowsCount) = lngIndex2

                        vntTemp = vntArray(lngIndex2, Abs(vntSortArray(intIndex)))

                    End If

                Next


                'letzte Zeile des zu sortierenden Bereichs

                lngRowsCount = lngRowsCount + 1

                lngRowsArray(0, lngRowsCount) = lngRowsArray(1, lngIndex1 + 1)


            Next

        End If

    Next

End Sub


Private Sub prcQuickSort(lngLbound As Long, lngUbound As Long, _

    intSortColumn As Integer, bntSortKey As Boolean, vntArray() As Variant)

    Dim intIndex As Integer

    Dim lngIndex1 As Long, lngIndex2 As Long

    Dim vntTemp As Variant, vntBuffer As Variant

    lngIndex1 = lngLbound

    lngIndex2 = lngUbound

    vntBuffer = vntArray((lngLbound + lngUbound) \ 2, intSortColumn)

    Do

        If bntSortKey Then

            Do While vntArray(lngIndex1, intSortColumn) < vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer < vntArray(lngIndex2, intSortColumn)

                lngIndex2 = lngIndex2 - 1

            Loop

        Else

            Do While vntArray(lngIndex1, intSortColumn) > vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer > vntArray(lngIndex2, intSortColumn)

                lngIndex2 = lngIndex2 - 1

            Loop

        End If

        If lngIndex1 < lngIndex2 Then

            If vntArray(lngIndex1, intSortColumn) <> _

                vntArray(lngIndex2, intSortColumn) Then

                For intIndex = LBound(vntArray, 2) To UBound(vntArray, 2)

                    vntTemp = vntArray(lngIndex1, intIndex)

                    vntArray(lngIndex1, intIndex) = _

                        vntArray(lngIndex2, intIndex)

                    vntArray(lngIndex2, intIndex) = vntTemp

                Next

            End If

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        ElseIf lngIndex1 = lngIndex2 Then

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        End If

    Loop Until lngIndex1 > lngIndex2

    If lngLbound < lngIndex2 Then Call prcQuickSort(lngLbound, _

        lngIndex2, intSortColumn, bntSortKey, vntArray())

    If lngIndex1 < lngUbound Then Call prcQuickSort(lngIndex1, _

        lngUbound, intSortColumn, bntSortKey, vntArray())

End Sub

weiß einer wie man makros aus .Net aufruft ?!

Link zu diesem Kommentar
Auf anderen Seiten teilen
Majestix

Majestix

Geschrieben
  • Autor
Geschrieben

How to run Office macros by using Automation from Visual Basic .NET

ist die lösung ;)


 Dim oExcel As Excel.ApplicationClass

        Dim oBook As Excel.WorkbookClass

        Dim oBooks As Excel.Workbooks


        'Start Excel and open the workbook.

        oExcel = DirectCast(CreateObject("Excel.Application"), Excel.ApplicationClass)

        oExcel.Visible = True

        oBooks = oExcel.Workbooks

        oBook = DirectCast(oBooks.Open("c:\template.xls"), Excel.WorkbookClass)


        'Run the macros.

        oExcel.Run("prcTest")

        ' oExcel.Run("DoKbTestWithParameter", "Hello from VB .NET Client")


        'Clean-up: Close the workbook and quit Excel.

        oBook.Close(False)

        System.Runtime.InteropServices.Marshal.ReleaseComObject(oBook)

        oBook = Nothing

        System.Runtime.InteropServices.Marshal.ReleaseComObject(oBooks)

        oBooks = Nothing

        oExcel.Quit()

        System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)

        oExcel = Nothing

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

×
 Teilen
Zur Themenübersicht

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Links

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...