Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Code Optmieren


Betrifft: Code Optmieren von: Stefan
Geschrieben am: 11.09.2019 18:59:54

Hallo Forum, Hallo Leute,

ich habe nachfolgend einen meiner Codes zum Suchen und Finden in meiner Datenliste.
Er funktioniert ist aber langsam und sieht erlich gesagt auch Schei.... aus. Bin eben Anfänger aber möchte auch dazu lernen. Würde mir jemand den Code Optieren und vlt. daduch flinker machen ???
Ich danke jetzt schon jeden der das macht würde !!!
Besten Dank Stefan

Private Sub cmdNummerSuchenMaus_Click()         'Nummer Suchen mit Maus klick
            Call sndPlaySound32("C:\Vereinsordner\Media\Windows Navigation Start.wav", 1) 'Ton Abspielen
            On Error Resume Next                            'Wenn Fehler dann weiter
            Dim X As Integer                                '
            Dim z As Integer                                '
                'ActiveSheet.Unprotect ""             'Blattschutz aufheben
                z = Sheets("Alle").UsedRange.Rows.Count     'Finde in Tabelle "Alle" die Bereiche
            If TextBox1 = "" Then Exit Sub                  'Wenn TextBox Leer dann Ende
                X = TextBox1                                'Nummer X zur Textbox1
                Temp = 0                                    'wenn 0 dann weiter
            For i = 3 To z                                  'Schleife Suchen in Spalte C4 bis Ende
            If Cells(i, 3) = X Then                         'Wenn in Spalte C Nummer X
                Temp = 1                                    'und 1 gefunden dann
            Exit For                                        'Schleife Ende
            End If                                          'Wenn Dann Ende
            Next                                            'Nächste
            If Temp = 1 Then                                'Wenn 1 gefunden dann
                Zeile = i                                   'in Zeile Springen und Daten Zeigen
                TextBox1 = Cells(Zeile, 3).Show             'C Liste Nr. Springe in Zeile 3
                TextBox64 = Cells(Zeile, 3)                 'C Liste Nr.
                TextBox21 = Cells(Zeile, 4)                 'D Tab Buchstabe
                ComboBox1 = Cells(Zeile, 5)                 'E Anrede
                TextBox2 = Cells(Zeile, 6)                  'F Name
                TextBox3 = Cells(Zeile, 7)                  'G Vorname
                TextBox4 = Cells(Zeile, 8)                  'H Straße
                TextBox5 = Cells(Zeile, 9)                  'I PLZ
                TextBox6 = Cells(Zeile, 10)                 'J Ort
                TextBox7 = Cells(Zeile, 11)                 'K Geb.
                TextBox8 = Cells(Zeile, 12)                 'L Alter
                TextBox9 = Cells(Zeile, 13)                 'M KAVO
                ComboBox3 = Cells(Zeile, 14)                'N Status
                TextBox66 = Cells(Zeile, 15)                'O Eintritt
                TextBox62 = Cells(Zeile, 16)                'P Jup.
                TextBox59 = Cells(Zeile, 17)                'Q Austritt
                TextBox17 = Cells(Zeile, 18)                'R Land
                TextBox18 = Cells(Zeile, 19)                'S Telefon
                TextBox16 = Cells(Zeile, 20)                'T Handy
                TextBox19 = Cells(Zeile, 21)                'U Fax
                TextBox20 = Cells(Zeile, 22)                'V EMail
                TextBox63 = Cells(Zeile, 23)                'W Liegeplatz
                TextBox11 = Cells(Zeile, 24)                'X 1. Datum
                ComboBox4 = Cells(Zeile, 25)                'Y 1. Auszeichnung
                TextBox47 = Cells(Zeile, 26)                'Z 2. Datum
                ComboBox5 = Cells(Zeile, 27)                'AA 2. Auszeichnung
                TextBox48 = Cells(Zeile, 28)                'AB 3. Datum
                ComboBox6 = Cells(Zeile, 29)                'AC 3. Auszeichnung
                TextBox49 = Cells(Zeile, 30)                'AD 4. Datum
                ComboBox7 = Cells(Zeile, 31)                'AE 4. Auszeichnung
                TextBox50 = Cells(Zeile, 32)                'AF 5. Datum
                ComboBox8 = Cells(Zeile, 33)                'AG 5. Auszeichnung
                TextBox56 = Cells(Zeile, 34)                'AH 6. Datum
                ComboBox9 = Cells(Zeile, 35)                'AI 6. Auszeichnung
                TextBox58 = Cells(Zeile, 36)                'AJ Bemerkung
                Label92 = Cells(Zeile, 37)                  'AK Letzte Aktualisierung
                ComboBox2 = Cells(Zeile, 38)                'AL Geschlecht
            Set Image1.Picture = LoadPicture("C:\Vereinsordner\Bilder\" & TextBox9.Value & ".jpg")
                Caption = "Datensatz von" & " " & TextBox3 & " " & TextBox2 & " " & "ändern oder löschen ?"
                Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
                Range("AZ3").Value = TextBox64.Value
                Range("E3:AL1003").Columns.AutoFit          'Spaltenbreite Automatik
                'ActiveSheet.Protect ""               'Blattschutz aktivieren
            If TextBox2.Value = "" Then TextBox2.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox3.Value = "" Then TextBox3.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox4.Value = "" Then TextBox4.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox5.Value = "" Then TextBox5.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox6.Value = "" Then TextBox6.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox7.Value = "" Then TextBox7.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox9.Value = "" Then TextBox9.BackColor = RGB(255, 255, 0)      'hintergrund gelb
            If TextBox13.Value = "" Then TextBox13.BackColor = RGB(255, 255, 0)    'hintergrund gelb
            If TextBox17.Value = "" Then TextBox17.BackColor = RGB(255, 255, 0)    'hintergrund gelb
            If ComboBox2.Value = "" Then ComboBox2.BackColor = RGB(255, 255, 0)    'hintergrund gelb
            If ComboBox1.Value = "" Then ComboBox1.BackColor = RGB(255, 255, 0)    'hintergrund gelb
            If TextBox2.Value <> "" Then Label73 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox2.Value = "" Then Label73 = "Datensatz ist unvollständig"                'Text
            If TextBox2.Value = "" Then Label88.BackColor = &HFF&                              'rot
            If TextBox2.Value <> "" Then Label88.BackColor = &HFF00&                           'grün
            If TextBox2.Value = "" Then Label89.BackColor = &HFF&                              'rot
            If TextBox2.Value <> "" Then Label89.BackColor = &HFF00&                           'grün
            If TextBox2.Value = "" Then Label90.BackColor = &HFF&                              'rot
            If TextBox2.Value <> "" Then Label90.BackColor = &HFF00&                           'grün
            If TextBox2.Value = "" Then Label91.BackColor = &HFF&                              'rot
            If TextBox2.Value <> "" Then Label91.BackColor = &HFF00&                           'grün
            If TextBox3.Value <> "" Then Label59 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox3.Value = "" Then Label59 = "Datensatz ist unvollständig"                'Text
            If TextBox4.Value <> "" Then Label60 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox4.Value = "" Then Label60 = "Datensatz ist unvollständig"                'Text
            If TextBox5.Value <> "" Then Label66 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox5.Value = "" Then Label66 = "Datensatz ist unvollständig"                'Text
            If TextBox6.Value <> "" Then Label67 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox6.Value = "" Then Label67 = "Datensatz ist unvollständig"                'Text
            If TextBox7.Value <> "" Then Label68 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox7.Value = "" Then Label68 = "Datensatz ist unvollständig"                'Text
            If TextBox9.Value <> "" Then Label69 = ""       'Enn TextBox Voll dann Label Leer, sonst
            If TextBox9.Value = "" Then Label69 = "Datensatz ist unvollständig"                'Text
            If TextBox13.Value <> "" Then Label70 = ""      'Enn TextBox Voll dann Label Leer, sonst
            If TextBox13.Value = "" Then Label70 = "Datensatz ist unvollständig"               'Text
            If TextBox17.Value <> "" Then Label82 = ""      'Enn TextBox Voll dann Label Leer, sonst
            If TextBox17.Value = "" Then Label82 = "Datensatz ist unvollständig"               'Text
            If ComboBox2.Value <> "" Then Label72 = ""      'Enn TextBox Voll dann Label Leer, sonst
            If ComboBox2.Value = "" Then Label72 = "Datensatz ist unvollständig"               'Text
            If ComboBox1.Value <> "" Then Label83 = ""      'Enn TextBox Voll dann Label Leer, sonst
            If ComboBox1.Value = "" Then Label83 = "Datensatz ist unvollständig"               'Text
                TextBox1 = ClearContents                    'TextBox Leeren
                TextBox1.BackColor = &H80000005             'weis
                TextBox14.BackColor = &H80000005            'weis
                cmdLöschen.Enabled = True
                cmdSpeichern.Enabled = False
                cmdNummerSuchenMaus.Enabled = False
                cmdNamenSuchenMaus.Enabled = False
                cmdÄndern.Enabled = True
                cmdNeueEingabe.Enabled = False
                cmdErweSucheMaus.Enabled = False
                cmdKAVO.Enabled = False
                cmdDirektTabellen.Enabled = False
                
            '    cmdAdrWeiter.Enabled = True
            '    cmdAdrZurück.Enabled = True
            Else                                            
                MsgBox "Listen-Nr. nicht vorhanden !", _
                vbInformation, " Hinweis für " & Application.UserName
                TextBox1 = ClearContents                    'TextBox Leeren
            End If                                          'Wenn Dann Ende
                
            End Sub
'Makro Ende
  

Betrifft: AW: Code Optmieren von: 1712547.html
Geschrieben am: 11.09.2019 19:39:42

Zeile = i kannst du weglassen und statt dessen überall i statt zeile eintragen.
Dann in den Schleifen so arbeiten:

If TextBox2.Value <> "" Then 
              Label73 = "" 
              ...
              ...
           Else 
              Label88.BackColor = &HFF00&  
              ...
              ...
           End If
Application.ScreenUpdating = False ist nicht unbed. nötig, das bringt nur in Schleifen etwas.
On Error Resume Next als Allheilmittel gegen mögliche Fehler ist Murks - so merkst du nicht mal, ob und wo Fehler auftauchen.
Was sollen diese Zeilen:
TextBox1 = Cells(zeile, 3).Show

oder
           
           TextBox1 = ClearContents  
TextBox1 = ""

reicht.
oder
Caption = ..... (Wessen Caption denn?)


  

Betrifft: AW: Code Optmieren von: 1712551.html
Geschrieben am: 11.09.2019 19:59:24

Hallo onur,

das mit i werde ich umsätzen,die TextBox1 = Cells(zeile, 3).Show bewirkt, dass der Datensatz in der Mitte des Monitor springt und so mit bedingter Formatierung angezeigt wird, ohne dem leider nicht. Vereinsmitgl. möchten dieses gerne haben. Zu TextBox1 = "" das habe ich vorher schon mal so gehabt aber da die Textboxen sich gelb färben wenn nicht drin steht und da gab es Anzeige Fehler, mit ClearContents komischer weise nicht und Caption = ..... ist der Userform Kopf das hab ich vergessen zu sagen. Asche auf's Haubt. Einige sachen warum Excel so handelt weis ich selber nicht ???

Gruß Stefan

  

Betrifft: AW: Code Optmieren von: 1712555.html
Geschrieben am: 11.09.2019 20:37:36

^Hallo Stefan,

wenn Du ein bißchen mehr Systematik bei der Benennung der TextBoxen hättest, dann wäre z.B. _ sowas möglich:

           Dim i As Integer
           For i = 2 To 20
               Me("TextBox" & i).Value = Cells(Zeile, i + 4).Value
           Next i
Den folgenden Befehl mußt Du splitten, sonst steht in TextBox1 nur WAHR oder FALSCH drin:
statt
Me.TextBox1.Value = Range("G59").Show
so
With Range("G59")
    .Show
    .Value = Range("G59").Value
End With

Gruß von Luschi
aus klein-Paris
  

Betrifft: AW: Code Optmieren von: 1712559.html
Geschrieben am: 11.09.2019 20:59:51

Hi Luschi,

werde umsetzten du hast recht besten dank !

Gruß Stefan

  

Betrifft: AW: Code Optmieren von: 1712663.html
Geschrieben am: 12.09.2019 12:26:19

Hi Luschi,

Mit der Textbox1 klappt super danke dafür aber dein
Dim i As Integer
For i = 2 To 20
Me("TextBox" & i).Value = Cells(Zeile, i + 4).Value
Next i
passiert nix ? Ich habe alle TB neu benannt, so das ich For i = 2 to 31 angepasst habe

Beste Grüße Stefan

  

Betrifft: AW: Code Optmieren von: 1712743.html
Geschrieben am: 12.09.2019 17:24:57

Da fehlt ein Punkt zw. "Me" und "Klammer auf".
Da du wahrscheinlich immer noch das blöde OnError drin hast, merkst du wieder mal nix.

  

Betrifft: AW: Code Optimieren von: 1712751.html
Geschrieben am: 12.09.2019 18:35:07

Hi onur,

muss dich leider enttäuschen, dass mit dem Punkt war mir nicht entgangen und das on Error ist auch raus.
Ich schreibe gerade meine gesamte Datenbank mit euren Hilfen um, da diese nun gar nicht läuft (vorher Fehlerfrei), ich halte aber niemanden den Spiegel vor deswegen. Deine Antwort Zitat:"merkst du wieder mal nix" ist im Bezug auf das on Error aber kann man auch so als auch so Lesen und verstehen ne. Liegt im Auge des Betrachters, nur mal so am Rande.

Ich danke trotzdem jedem hier für die Hilfen die man bekommt.
Ich lasse den Thread jetzt auch zu.

Also Beste Grüße Stefan

  

Betrifft: AW: Code Optimieren von: 1712752.html
Geschrieben am: 12.09.2019 18:36:13

Poste doch mal die gesamte Datei.

  

Betrifft: AW: Info für onur und Luschi und jeden anderen :-) von: 1712962.html
Geschrieben am: 13.09.2019 16:00:09

Hi Ihr beiden,

Ich habe jetzt die ganze Nacht durch Programmiert nach euren Hilfestellungen. Es ist jetzt definitiv überall OnError raus! Ich habe noch zusätzlich in jeden Code doch wieder das SceenUpdating eingesetzt aber diesmal noch mit EnableEvents und Calculation =XlManuell jeweils am Anfang und auch am Ende entsprechend angepasst. Alles läuft erheblich schneller. Der Vorschlag von Luschi mit der Textbox1 das diese Wahr und Falsch sonst anzeigt wahr richtig gut ! Die restlichen Textboxen mit Me Bekomme ich nicht zum laufen. Me( passiert nix, Me.( gibt einen Fehler aus und Me.Controls( geht auch nicht. Dim i as .... gibt er auch ein Fehler aus. Ich habe die Boxen wieder untereinander geschrieben und läuft. Die Fehlertexte weiß ich jetzt nicht mehr aus dem Kopf, da ich gerade mit dem Pad schreibe.

Falls noch jemand Ideen hat gerne schreiben Code ist ganz oben, ansonsten danke an onur und Luschi

Beste Grüße Stefan

  

Betrifft: AW: Info für onur und Luschi und jeden anderen :-) von: 1713088.html
Geschrieben am: 14.09.2019 18:16:31

Hallo Stefan,

da gibt es jetzt ein Problem. Deinen "neuen Code" kennst nur du.

Also bitte den Code hier mal zeigen, noch besser eine Beispielmappe hochladen.

Gruß Werner

  

Betrifft: AW: Code Optmieren von: 1712556.html
Geschrieben am: 11.09.2019 20:47:02

"ClearContents komischer weise nicht" - nur weil

On Error Resume Next

alle Fehlermeldungen unterdrückt.
  

Betrifft: AW: Code Optmieren von: 1712558.html
Geschrieben am: 11.09.2019 20:58:11

Hallo onur,

ah verstehe !

gruß Stefan