Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Gruß Atilla
Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
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
Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
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
Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Gruß Atilla
Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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 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
Gruß Atilla
Registriert seit: 23.01.2017
Version(en): 365 - Version 2208
Hallo Atilla, japp... 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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
(04.02.2017, 18:24)Klaus schrieb: 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.
Gruß Atilla
|
