Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
912to916
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
912to916
912to916
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spaltenüberschriften zu best. Zellen auslesen |VBA

Spaltenüberschriften zu best. Zellen auslesen |VBA
09.10.2007 09:52:02
Wissensdurst
Hallo Excelfreunde,
ich habe mal wieder in kleines Problem. Ich würde gerne zu einer gewissen Zelle X alle Spaltenüberschriften der Zellen auslesen, die links davon stehen und bestimmte Kriterien erfüllen. An einem Beispiel verdeutlicht:
In Spalte A stehen Usernamen, in Spalte B, C, D usw. steht in Zeile 1 eine Überschrift (Produkt A, Produkt B usw.) und darunter jeweils eine Anzahl, wie oft der jeweilige User dieses Produkt besitzt.
Was ich nun versuche hinzubekommen, ist, dass per Makro eine Liste erstellt wird (möglichst auf einem anderen Tabellenblatt), welche Produkte ein User hat (nicht aber die, die er nicht hat). Das soll so ablaufen, dass man mit der Maus eine Zelle (einen User) in Spalte A markiert, welcher zum Beispiel in Spalte B den Wert 1, in Spalte C keinen Wert (leer) und in Spalte D den Wert 2 hat, und dann einen Button zum Ausführen des Makros drückt.
In der Liste soll dann aber nur ausgegeben werden:
User X:
Produkt B: 1
Produkt D: 2
Spalte C fällt also in der Liste weg, da diese keinen Wert enthält; ebenso soll es mit Spalten sein, bei denen der Wert 0 ist. Das bereitet mir irgendwie Schwierigkeiten. Ähnlich schlimm ist es damit, nicht nur die Werte der Zellen auszugeben, die links vom User stehen, sondern eben auch die Spaltenüberschriften dazu.
Vielleicht könnt Ihr mir da ja weiterhelfen, bin für jeden Tipp dankbar.
Beste Grüße
Christian

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenüberschriften zu best. Zellen auslesen |VBA
09.10.2007 10:13:00
Jan3
Hi,
Sicherlich hast Du eine Beispieltabelle dazu. Damit kann man alles viel besser anpassen.
Jan

AW: Spaltenüberschriften zu best. Zellen auslesen |VBA
09.10.2007 10:53:17
Worti
Hallo Christian,
wenn ich es richtig verstanden habe, dann ungefähr so:


Sub ListeErstellen()
    Dim wsQuelle As Worksheet, wsZiel As Worksheet
    Dim lngZeile As Long
    Dim lngAusgabeZeile As Long
    Dim intSpalte As Integer
    Dim bolListeDa As Boolean, bolUserDa As Boolean
    bolListeDa = SheetExists("Liste")
    If bolListeDa Then
       Set wsZiel = ThisWorkbook.Worksheets("Liste")
       wsZiel.Cells.Clear
    Else
       Set wsZiel = ThisWorkbook.Worksheets.Add
       wsZiel.Name = "Liste"
    End If
    Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1")
    lngAusgabeZeile = -1
    For lngZeile = 2 To wsQuelle.Cells(Rows.Count, 1).End(xlUp).Row
        bolUserDa = False
        For intSpalte = 2 To 5 '<-- Spalte 2 bis 5 beinhalten Produktzahlen
            If IsNumeric(wsQuelle.Cells(lngZeile, intSpalte)) And _
               wsQuelle.Cells(lngZeile, intSpalte).Value > 0 Then
               If Not bolUserDa Then
                  bolUserDa = True
                  lngAusgabeZeile = lngAusgabeZeile + 2
                  wsZiel.Cells(lngAusgabeZeile, 1).Value = wsQuelle.Cells(lngZeile, 1).Value
                  wsZiel.Cells(lngAusgabeZeile + 1, 1).Value = wsQuelle.Cells(1, intSpalte).Value
                  wsZiel.Cells(lngAusgabeZeile + 1, 2).Value = wsQuelle.Cells(lngZeile, intSpalte).Value
                  lngAusgabeZeile = lngAusgabeZeile + 1
               Else
                  lngAusgabeZeile = lngAusgabeZeile + 1
                  wsZiel.Cells(lngAusgabeZeile, 1).Value = wsQuelle.Cells(1, intSpalte).Value
                  wsZiel.Cells(lngAusgabeZeile, 2).Value = wsQuelle.Cells(lngZeile, intSpalte).Value
               End If
            End If
        Next intSpalte
    Next lngZeile
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
End Sub
'Prüfen, ob ein Blatt in einer Arbeitsmappe existiert - von NoNet
Function SheetExists(blattname) As Boolean
    Dim Dummy
    On Error Resume Next
    Dummy = Sheets(blattname).Type
    SheetExists = (Err = 0)
End Function


Gruß Worti

Anzeige
AW: Spaltenüberschriften zu best. Zellen auslesen
09.10.2007 13:40:00
Wissensdurst
Hallo Worti,
mein Respekt ist Dir sicher! Ich dachte vorhin, warteste mal n paar Stündchen, bis du wieder reinschaust, aber dass es jemand schafft, innerhalb so kurzer Zeit so eine Lösung zusammenzubasteln - Wahnsinn!
Funktioniert auch einwandfrei! Das Einzige, was mich noch etwas stört, ist, dass mir immer gleiche alle User auf einmal ausgegeben werden. Optimal wäre natürlich, wenn immer nur der User ausgegeben werden könnte, dessen Zelle gerade markiert ist.
Ich habe gerade versucht, die entsprechende Stelle in deinem Quelltext zu finden, aber irgendwie weiss ich innerhalb der Schleifen nicht, wo ich ansetzten muss, ohne da was kaputt zu machen ;)
Wäre super, wenn Du mir da nochmal unter die Arme greifen könntest.
Tausend Dank
Christian

Anzeige
AW: Spaltenüberschriften zu best. Zellen auslesen
09.10.2007 14:37:46
Wissensdurst
Hallo Worti,
mein Respekt ist Dir sicher! Ich dachte vorhin, warteste mal n paar Stündchen, bis du wieder reinschaust, aber dass es jemand schafft, innerhalb so kurzer Zeit so eine Lösung zusammenzubasteln - Wahnsinn!
Funktioniert auch einwandfrei! Das Einzige, was mich noch etwas stört, ist, dass mir immer gleiche alle User auf einmal ausgegeben werden. Optimal wäre natürlich, wenn immer nur der User ausgegeben werden könnte, dessen Zelle gerade markiert ist.
Ich habe gerade versucht, die entsprechende Stelle in deinem Quelltext zu finden, aber irgendwie weiss ich innerhalb der Schleifen nicht, wo ich ansetzten muss, ohne da was kaputt zu machen ;)
Wäre super, wenn Du mir da nochmal unter die Arme greifen könntest.
Tausend Dank
Christian

Anzeige
AW: Spaltenüberschriften zu best. Zellen auslesen
09.10.2007 15:32:00
Worti
Hallo Christian,
so gehts für eine momentan selektierte Zeile:


Sub ListeErstellen2()
    Dim wsQuelle As Worksheet, wsZiel As Worksheet
    Dim lngZeile As Long
    Dim lngAusgabeZeile As Long
    Dim intSpalte As Integer
    Dim bolListeDa As Boolean, bolUserDa As Boolean
    lngZeile = Selection.Row
    bolListeDa = SheetExists("Liste")
    If bolListeDa Then
       Set wsZiel = ThisWorkbook.Worksheets("Liste")
       wsZiel.Cells.Clear
    Else
       Set wsZiel = ThisWorkbook.Worksheets.Add
       wsZiel.Name = "Liste"
    End If
    Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1")
    bolUserDa = False
    lngAusgabeZeile = 1
    For intSpalte = 2 To 5 '<-- Spalte 2 bis 5 beinhalten Produktzahlen
        If IsNumeric(wsQuelle.Cells(lngZeile, intSpalte)) And _
           wsQuelle.Cells(lngZeile, intSpalte).Value > 0 Then
              If Not bolUserDa Then
                 wsZiel.Cells(lngAusgabeZeile, 1).Value = wsQuelle.Cells(lngZeile, 1).Value
                 wsZiel.Cells(lngAusgabeZeile + 1, 1).Value = wsQuelle.Cells(1, intSpalte).Value
                 wsZiel.Cells(lngAusgabeZeile + 1, 2).Value = wsQuelle.Cells(lngZeile, intSpalte).Value
                 lngAusgabeZeile = lngAusgabeZeile + 2
                 bolUserDa = True
              Else
                 wsZiel.Cells(lngAusgabeZeile, 1).Value = wsQuelle.Cells(1, intSpalte).Value
                 wsZiel.Cells(lngAusgabeZeile, 2).Value = wsQuelle.Cells(lngZeile, intSpalte).Value
                 lngAusgabeZeile = lngAusgabeZeile + 1
              End If
        End If
    Next intSpalte
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
End Sub
'Prüfen, ob ein Blatt in einer Arbeitsmappe existiert - von NoNet
Function SheetExists(blattname) As Boolean
    Dim Dummy
    On Error Resume Next
    Dummy = Sheets(blattname).Type
    SheetExists = (Err = 0)
End Function

Gruß Worti

Anzeige
AW: Spaltenüberschriften zu best. Zellen auslesen
09.10.2007 16:14:57
Wissensdurst
Super, funktioniert einwandfrei!
Werde jetzt mal versuchen, das Ganze nachzuvollziehen ;)
Vielen Dank nochmal!
Christian

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige