Listen Nr. aus Spalte berechnen

Hallo Zusammen,
ich habe in einer Excel Tabelle, etliche gleichartige Tabellen nebeneinander platziert.

Also so:

A: Spalte 1 | B: Spalte 2 | C: Spalte 3 | D: Spalte 4 | E: Spalte 5 | F: Spalte 1 | G: Spalte 2 | H: Spalte 3 | I: Spalte 4 | J: Spalte 5 | usw.

Zur Zeit hat also jede Teiltabelle 5 Spalten, was sich aber ändern kann, z.B. auf 4 Spalten und dann gilt es für alle Listen der Tabelle.

Ich möchte nun in VBA die x-Pos des Cursors abfragen und die Listen Nr. zurück erhalten.

Beispiel xAkt = 7

Die Listennr. soll mit 0 beginnen (0, 1, 2, usw.)

7 liegt innerhalb der zweiten Liste, also möchte ich eine 1 zurückbekommen. Bei xAkt =12 müßte eine 2 für die dritte Liste zurück kommen.

Mit If Then oder Select Case ist das ganz einfach zu lösen, allerdings wäre dann die maximale Listennr, immer auf die Zahl der Case Anweisungen beschränkt.

Ich vermute man kann das auch mit einer Formel ausrechnen und genau diese suche ich.

Vielleicht hatte schon mal jemand diesen Anwendungsfall oder durchschaut die Formel auf die schnelle.
Besten Dank.
Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function ListenIndex(ByVal Spalte&, ByVal SpOffset&) As Long Select Case Spalte Case (SpOffset * 0) + 1 To SpOffset * 1 ListenIndex = 0 Case (SpOffset * 1) + 1 To SpOffset * 2 ListenIndex = 1 Case (SpOffset * 2) + 1 To SpOffset * 3 ListenIndex = 2 Case Else ListenIndex = 999 MsgBox "Fehler" End Select End Function

Hallo Eddie,

es ist ja die Frage, was Du unter "Listenindex" verstehst.
Nehmen wir an, Du hättest den Default-Namen der Tabelle übernommen: "Tabelle1", "Tabelle2", usw.
Dann geht man durch alle Tabellen und prüft , ob die ActiveCell darin positioniert ist,
wenn ja, extrahiert man den Zahl am Ende des Namen:



Function ListenIndex(ByVal Spalte&, ByVal SpOffset&) As Long

Dim L As ListObject



    For Each L In ActiveSheet.ListObjects

        If Not Intersect(ActiveCell, L.DataBodyRange) Is Nothing Then

            ListenIndex = RegExExtrakt(L.Name, "\d+$")

            Exit Function

        End If

    Next

    ListenIndex = -1

End Function



Function RegExExtrakt(ByVal Target, ByVal Pattern) As String

Dim R

    If TypeOf Target Is Range Then Target = Target.Cells(1).Value

    Set R = CreateObject("VBScript.RegExp")

    R.Pattern = Pattern

    On Error Resume Next

    RegExExtrakt = R.Execute(Target)(0)

End Function

Alternativ:
Spalte 1-5 = 1
Spalte 6-10 = 2
usw.
also:

Function ListenIndex(ByVal Spalte As Long, byval Optional SpOffset As Long = 5) As Long

    ListenIndex = Int((i - 1) / SpOffset) + 1

End Function

VG
Yal

Function ListenIndex() As Long Dim L As ListObject For Each L In ActiveSheet.ListObjects If Not Intersect(ActiveCell, L.DataBodyRange) Is Nothing Then ListenIndex = CLng(Split(L.Name, "_")(1)) Exit Function End If Next ListenIndex = -1 End Function

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread