Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
672to676
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
672to676
672to676
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Fehler im Quellcode

Fehler im Quellcode
02.10.2005 15:01:57
juliane
Hallöchen,
Ich hoffe, es kann mir jemand bei meinem Problem helfen.
Ich möchte aus einer Tabelle, wo Zeit- und Ortsangaben drin stehen, alle unterschiedlichen Orte auslesen und diese als Spalten-überschriften in einer neuen Tabelle wiedergeben.
Im nächsten Schritt sollen alle Zeiten, die zu den jeweiligen Orten gehören, in der neue Tabelle eingetragen werden. Dabei ist zu beachten, dass in einer Zeile immer nur eine Zeit stehen darf.
Ich hab schon versucht dieses umzusetzten, komme jetzt aber nicht weiter.
https://www.herber.de/bbs/user/27120.xls
Für euere Hilfe schon mal Vielen Dank!
Juliane

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler im Quellcode
02.10.2005 18:49:39
Nepumuk
Hallo Juliane,
versuch es mal damit:
Option Explicit

Public Sub Uebersicht()
    Dim vntArray As Variant, vntTemp As Variant
    Dim lngRow As Long
    Dim intColumn As Integer, intIndex As Integer
    Dim objCell As Range
    vntTemp = Chr$(0)
    Application.ScreenUpdating = False
    With Worksheets("gegeben")
        vntArray = .Range(.Cells(4, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2))
        Call prcQuickSort(LBound(vntArray), UBound(vntArray), 1, True, vntArray)
        For lngRow = LBound(vntArray) To UBound(vntArray)
            If vntArray(lngRow, 1) <> vntTemp Then
                intColumn = intColumn + 1
                With Worksheets("Loesung").Cells(1, intColumn)
                    .Value = vntArray(lngRow, 1)
                    .Font.Bold = True
                    .HorizontalAlignment = xlHAlignRight
                    For intIndex = 7 To 10
                        With .Borders(intIndex)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .Color = vbBlack
                        End With
                    Next
                End With
                vntTemp = vntArray(lngRow, 1)
            End If
        Next
        For lngRow = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row
            Set objCell = Worksheets("Loesung").Rows(1).Find(What:=.Cells(lngRow, 2), _
                LookIn:=xlFormulas, LookAt:=xlWhole)
            .Cells(lngRow, 1).Copy Worksheets("Loesung").Cells(lngRow - 2, objCell.Column)
        Next
    End With
    With Worksheets("Loesung")
        For intColumn = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            With .Range(.Cells(2, intColumn), .Cells(lngRow - 3, intColumn))
                .HorizontalAlignment = xlHAlignRight
                For intIndex = 7 To 10
                    With .Borders(intIndex)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .Color = vbBlack
                    End With
                Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
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

Gruß
Nepumuk

Anzeige
AW: Fehler im Quellcode
03.10.2005 10:01:21
juliane
Guten Morgen Nepumuk,
Vielen, vielen Dank für deine Hilfe. Wie ich das so sehe, hätte ich es nie allein geschafft.
Wenn ich den Quellcode mit Einzelschritten duchgehe, dann zeigt er mir in der Zeile 9:"with worksheets("gegeben") " einen "Laufzeitfehler'9': index außerhalb des gültigen Bereichs" an.
Kannst du mir bitte einen Tip geben, wie ich diesen Fehler beheben kann?
Vielen Dank
Juliane
AW: Fehler im Quellcode
03.10.2005 10:23:50
Nepumuk
Hallo Juliane,
das bedeutet, dass es keine Tabelle mit dem Namen "gegeben" in der Mappe gibt. Es könnte aber auch sein, dass du im Namen der Tabelle ein führendes oder abschließendes Leerzeichen hast. Prüfe das mal.
Gruß
Nepumuk

Anzeige
AW: Fehler im Quellcode
03.10.2005 12:54:19
juliane
Hallo,
Super, du hattest recht und jetzt klappt alles!
Vielen, vielen Dank,
Liebe Grüße Juliane

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige