Tabellenspalten in UF darstellen

[Klaus]

ahhhhhhh... verstehe.... glaube zu verstehen

Die Spalte H gibt die Richtung vor.

Dort werden sozusagen die Anzahl der Spalten gezählt.
Jede Spalte eine Zelle in H.
Fehlt in H eine Beschreibung in einer Zelle, dann ist da auch automatisch eine Spalte weniger.

...zumindest funktioniert das
 nach reiflichem Durchdenken dieser Zeile bzw des Kommentars bin ich darauf gekommen dass das so sein müsste...

Code:

For i = 2 To lngS   'Frames 2 bis soviele Einträge wie in Spalte H mit den Werten aus Spalte H beschriften

na fein... 

dann noch hier ein +1 dazu - dann klappte das auch mit der Beschriftungsreihenfolge in Frame1

Code:

Me.Frame1.Caption = Cells(lngZ + 1, 8)

Also ich glaube jetzt hab ichs...

...

naja... oder auch nicht...
der klick auf einen clearButton stoppte meinen Glauben...

Code:

Me.Controls("Listbox" & lngZ + 1).ListIndex = -1    'Listindex der vorher ausgewählten Listbox auf -1 setzen um die markierung wegzunehmen

...spielt nicht mit...

 Besser ich schlaf mal drüber. Das gibt heut nix gescheites mehr...

gut Nacht
Liebe Grüße
Klaus

[atilla]

Halllo Klaus,

da Dir meine Variablen Deklaration nicht so gefiel, weil ich teilweise die Variablen unterschiedlich nutzte, habe ich jetzt etwas "sprechendere" Definitionen genutzt.
Außerdem ist der Code relativ flexible und gut anpassbar. Ich Denke mitlerweile bist Du auch schon soweit, dass Du den Code auch ohne Kommentare verstehen würdest.

Ich weiß nicht, wie intensiv Du den Code getestet hast, aber ich hab festgestellt, dass es unter bestimmten Gegebenheiten zu Fehlern kommt.
Das und Dein "Verständniswille" bezüglich des Codes ist ein Grund, warum ich den Code verändert habe. Bei der Gelegenheit konnte ich ihn noch einmal zusammenstutzen.

Code:

Option Explicit
Private Const WerteSpalte = 8   'hier ist festgelegt, in welcher Spalte die werte stehen (Bei Bedarf nur die Zahl für die Spalte anpassen)
Private Const EintragSpalte = 9 'hier wird die Spalte angegeben, in welche geschrieben wird

Private Sub CommandButton1_Click()
 löschen
End Sub

Private Sub CommandButton2_Click()
 löschen
End Sub
Private Sub CommandButton3_Click()
 löschen
End Sub

Private Sub CommandButton4_Click()
 löschen
End Sub
Private Sub CommandButton5_Click()
 löschen
End Sub

Private Sub CommandButton6_Click()
 löschen
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 If ListBox1.ListCount Then   'wenn Anzahl Einträge in listbox1 dann
   listbox_füllen
'    DoEvents         'Übergibt die Steuerung an das Betriebssystem, damit es andere Ereignisse verarbeiten kann
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1    'wenn Einträge in der listbox dann Listindex auf -1 -> damit keine Auswahl
   Application.Wait (Time + TimeValue("00:00:01"))             'Codeausführung für 1 sec anhalten
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1
 End If
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'bei Doppelklick auf die Userform
 UserForm_Initialize 'Userform wird neu geladen; alles was beim ersten Laden passierte, wird erneut ausgeführt.
End Sub

Private Sub UserForm_Initialize()
 Dim i As Long
 Dim EintragLetzteZeile As Long
 Dim ListeSpaltenLetzteZeile As Long, WerteLetzteZeile As Long

 ListeSpaltenLetzteZeile = Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zelle Spalte A
 WerteLetzteZeile = Cells(Rows.Count, WerteSpalte).End(xlUp).Row 'letzte belegte Zelle Spalte H
 EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
 Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).ClearContents
'  Range("I2:I" & Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1).ClearContents 'I2 bis letzte belegte Zelle Inhalte löschen
 
 If WerteLetzteZeile < 2 Then                      'wenn Spalte H weniger als zwei Einträge
   MsgBox "Keine Auswahl eingetragen!"
   Exit Sub
 End If

 ListBox1.List = Range(Cells(2, 1), Cells(ListeSpaltenLetzteZeile, 1)).Value 'Listbox1 aus Spalte A füllen
 Frame1.Caption = Range("A1")    'Frame1 beschriften mit Überschrift aus Spalte A
 
 For i = 2 To WerteLetzteZeile   'Frames 2 bis soviele Einträge wie in Spalte H mit den Werten aus Spalte H beschriften
   Me.Controls("Frame" & i).Caption = Cells(i, WerteSpalte)
 Next i
 
 For i = 1 To WerteLetzteZeile - 1    'In die Tag Eigenschaft der Schaltflächen den Wert von i reinschreiben
   Me.Controls("CommandButton" & i).Tag = i
 Next i
 Me.Tag = 2      'Userform Tag wird der wert 2 eingetragen, Dieser Wert wird bei Doppelklick in die Listbox abgefragt und ist dann die Schreibzeile
 Me.ListBox2.ListIndex = 0
End Sub


Sub löschen()     'wird bei Clear Schaltflächen ausgeführt
 Dim i As Long, j As Long
 Dim EintragLetzteZeile As Long, ListeSpaltenLetzteZeile As Long
 EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row 'Letzte belegte Zelle in Spalte EintragSpalte
 
 j = ActiveControl.Tag   'der Wert in der Tag Eigennschaft der aufrufenden Schaltfläche wird an Variable j übergeben
 Me.Tag = j + 1      'Der glkeiche Wert wird in die Tag Eigenschaft der Userform geschrieben
 If j < EintragLetzteZeile Then    'Wenn Userfoerm Tag = 0 und j (Schaltflächenindex) < letzte belegte Zeile in Spalte I
   ListeSpaltenLetzteZeile = Cells(Rows.Count, j).End(xlUp).Row   'Letzte belegte Zelle in Spalte j=Schaltflächenindex
   Cells(j + 1, EintragSpalte) = ""                        'Zelleninhalt leeren
   ListBox1.List = Range(Cells(2, j), Cells(ListeSpaltenLetzteZeile, j)).Value 'Bereich aus Spalte j=Schaltflächenindex und letzten Zelle aus Spalte j=Schaltflächenindex in listbox1 einlesen
   Me.Frame1.Caption = Cells(j + 1, WerteSpalte).Value     'Frame1 neu beschriften mit der Überschrift der eingelesenen Spalte
   Me.Controls("Listbox" & j + 1).BackColor = RGB(500, 0, 0) 'Listbox mit dem Index der aufrufenden Schaltfläche +1 roter Hintergrund
   Me.Controls("Listbox" & EintragLetzteZeile + 1).ListIndex = -1    'Listindex der vorher ausgewählten Listbox auf -1 setzen um die Markierung wegzunehmen
   Me.Frame1.SetFocus
 End If
End Sub

Sub listbox_füllen()

 Dim i As Long, j As Long, lngAnzahl As Long
 Dim WerteLetzteZeile As Long, EintragLetzteZeile As Long, FreieZelleZeile As Long, ListeSpaltenLetzteZeile As Long
 
 WerteLetzteZeile = Cells(Rows.Count, WerteSpalte).End(xlUp).Row  'letzte  belegte Zelle in Spalte H
 EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
 FreieZelleZeile = Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).SpecialCells(xlCellTypeBlanks).Row

 If FreieZelleZeile <= WerteLetzteZeile Then
   Cells(Me.Tag, EintragSpalte) = Me.ListBox1
   EintragLetzteZeile = Cells(Rows.Count, EintragSpalte).End(xlUp).Row + 1 'erste freie Zelle in Spalte I
   FreieZelleZeile = Range(Cells(2, EintragSpalte), Cells(EintragLetzteZeile, EintragSpalte)).SpecialCells(xlCellTypeBlanks).Row
   If FreieZelleZeile < WerteLetzteZeile + 1 Then
     Me.Controls("Listbox" & Me.Tag).BackColor = &H8000000F
     ListeSpaltenLetzteZeile = Cells(Rows.Count, FreieZelleZeile - 1).End(xlUp).Row
     Me.ListBox1.List = Range(Cells(2, FreieZelleZeile - 1), Cells(ListeSpaltenLetzteZeile, EintragLetzteZeile)).Value
     Me.Controls("Listbox" & FreieZelleZeile).ListIndex = 0
     Me.Frame1.Caption = Cells(FreieZelleZeile, WerteSpalte)
     Me.Tag = FreieZelleZeile
   Else
     Me.ListBox1.Clear
     Me.Controls("Listbox" & Me.Tag).ListIndex = -1
     Me.Controls("Listbox" & Me.Tag).BackColor = &H8000000F
     Me.Frame1.Caption = ""
   End If
 End If
 
End Sub

Beachte unbedingt die zwei Konstanten unter Option Explicit

[Klaus]

Guten Abend Atilla,

da kommt mir ja einfach nur ein "wow" über die Lippen.
Das läuft aber sehr flüssig. Das merkt man aber gleich! Sehr schön!

Bin schwer begeistert  

Jetzt werd ich das erstmal ins Original einbauen und dann werd ich den Code schön in Ruhe studieren. Malsehen wie weit ich damit komme  :21:

Allerbesten Dank für die viele Müh.

Liebe Grüße
Klaus

[Klaus]

Hallo Atilla,

bin nun durch mit testen und grübeln :D

Ich glaube wir müssten der Spalte B einen festen Bereich für die Auswahl der Listbox1 geben. (So das möglich ist)
Das ist die Spalte, die irgendwann mal länger als alle anderen sein wird.
Hab mal 150 Zeilen gefüllt. (Ich denke aber mehr als 200 - 250 werden es nicht werden)
Jetzt ist schon ein sehr deutlicher Unterschied bei der Ladezeit zu allen anderen Spalten zu spüren. 
Das wird wohl nicht klappen. (Mit einer festen Range ist er doch schneller oder?)

Im Grunde ist das längere Laden ja nicht schlimm - nur man denkt eben das nichts mehr passiert - das PC aufgegeben hat...
Wenn man so eine Eieruhr, Runterzähler oder Ladebalken anzeigen könnte, würde das ja auch schon gehen
Sicherlich würde sowas wieder noch mehr Zeit kosten, aber dann wüsste man wenigstens das er nicht eingefroren ist und unterlässt dieses automatische rumgetippe in der UF 


aber... Bettzeit nun erstmal... ich kann mich nicht mehr konzentrieren... 

Gute Nacht
Klaus

[Klaus]

nein halt - kommando zurück...
hab schnell noch die 150 mal in die beispieldatei gesteckt...
hier flitzt er nur so durch... ein augenschmaus...
liegt also an der orginaldatei.
muss ich mir morgen nochmal zur brust nehmen das teil... 

jetzt aber bettchen
gut nacht

[atilla]

Hallo Klaus,

beim neu Laden der Lisbox wird es sicher keinen Zeitunterschied geben ob 150 oder 1000 (tausend) Zeilen eingelesen werden.
Ich kann mir aber vorstellen, dass bei Dir das schreiben in die Zelle Zeit in Anspruch nimmt. Obwohl Du nur eine Zelle beschreibst.
Das könnte an Formeln und Bedingter Formatierung liegen, die dabei neu berechnet werden.

Du könntest es damit versuchen, dass Du die Berechnung zu beginn aus- und am Ende wieder einschaltest.
Das könnte im Doppelklick-Ereignis der Listbox1 untergebracht werden.
Z.B. so:

Code:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo ende
Application.Calculation = xlCalculationManual
 If ListBox1.ListCount Then   'wenn Anzahl Einträge in listbox1 dann
   listbox_füllen
'    DoEvents         'Übergibt die Steuerung an das Betriebssystem, damit es andere Ereignisse verarbeiten kann
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1    'wenn einträge in der listbox dann Listindex auf -1 -> damit keine Auswahl
   Application.Wait (Time + TimeValue("00:00:01"))             'Codeausführung für 1 sec anhalten
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1
 End If
ende:
Application.Calculation = xlCalculationAutomatic
End Sub

[Klaus]

Hallo Atilla,

da kommst du nie drauf was das war

Bei der Übernahme der Werte aus der Quelldatei hab ich das so gemacht, dass die ganze Spalte einfach rüber kopiert wird.
In dieser Spalte standen ab Zelle 1000irgendwas Formeln mit Verknüpfungen zu der Quelldatei.
Und die hat der fleißig immer erst aktualisiert.
Wer auch immer die Quelldatei zusammengestrickt hat, hat mir ein ganz schönes Ei ins Nest gelegt.
Die werd ich mir wohl auch nochmal vornehmen müssen....

Ich schneide jetzt diesen Teil unterhalb der relevanten Daten nach Übernahme einfach ab.
Jetzt flitzt der Code wieder durch die UF - herrlich

Hab aber trotzdem mal Deinen liebenswerter Weise angepassten Code getestet. 
Hier verfängt sich die UF dann aber in der Markierung der rechten Boxen. Da ist dann immer eine mehr markiert als eigentlich sein dürfte.

Ein anderes Problem macht mir aber grad Sorgen.
Wahrscheinlich ist mein PC für die Datenmengen zu klein?!
Wenn ich eine Weile teste... (hier werden Daten ständig zwischen drei verschiedenen Dateien hin und her geschoben. Diese auf und zu gemacht usw...) dann ist Excel (und nur Excel - Browser, Explorer alles nicht betroffen) einfach schwarz. Nix geht dann mehr... 
Da kann man einen Kaffee machen gehen und danach ist der Bildschirm wieder da... 

Diesen hier verwende ich an entsprechend möglichen Stellen... aber entweder ist das der falsche Weg, oder es reicht nicht. Oder aber meine Überlegung dazu passt nicht  :20:

Code:

Application.CutCopyMode = False

Liebe Grüße
Klaus

[atilla]

Hallo Klaus,

ganz daneben lag ich ja nicht, ich schrieb ja, dass es an neu Berechnungen von Formeln liegen könnte.
Das mit dem markieren in der Listbox ist mir auch aufgefallen. Das war ja jetzt nur zu Testzwecken, um festzustellen, ob es schneller geht ohne Berechnung.
Wahrscheinlich braucht die SpecialCells Methode, die ich an einer Stelle verwende die Berechnung, und deswegen wurde die Markierung nicht aufgehoben.

Das mit

Code:

CutCopyMode

verstehe ich nicht. Das braucht man nur beim Kopieren und Einfügen. Wozu soll das an verschiedenen Stellen gut sein?

Aber wenn Du die Möglichkeit hast, dann würde ich schon beim öffnen der Datei die Berechnung auf manuell umstellen und je nach bedarf anstoßen.
Das kann man per Code so regeln:

beim Öffnen der Datei:

Code:

Private Sub Workbook_Open()
 Application.Calculation = xlCalculationManual 'Autoberechnung aus
End Sub

und beim Schließen:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Application.Calculation = xlCalculationAutomatic  'Autoberechnung ein
End Sub

Beides gehört ins Codemodul DieseArbeitsmappe

[Klaus]

Hallo Atilla,

japp... 

Code:

CutCopyMode

zum löschen des Zwischenspeichers...
ich hab das nach jedem Einfügen eingebracht. Wahrscheinlich hätte es tatsächlich gereicht das nach dem letzten Einfügen zu verwenden. Aber ich dachte mir, dass das so vielleicht für den Speicher/PC "einfacher" ist wenn er nicht den ganzen Restmüll in der Tasche behält wenn er sich durch den Code arbeitet.

Das Ein/Ausschalten der Autoberechnung wirkt sich doch aber auf die verwendeten Formeln in der Mappe aus?! Ich glaub das kann ich so nicht machen oder?
Liebe Grüße
Klaus

[atilla]

Das Ein/Ausschalten der Autoberechnung wirkt sich doch aber auf die verwendeten Formeln in der Mappe aus?! Ich glaub das kann ich so nicht machen oder?
Liebe Grüße
Klaus

Klar. Deswegen schrieb ich ja, dass du es dann bei bedarf anstoßen musst.
Das hieße, dass Du genau wissen musst, wann eine Neuberechnung nötig ist und wann nicht.

War ja nur eine Idee, manchmal ist es sinnvoll, ein anderes mal eben nicht. Deine Entscheidung.