05.08.2010

6233

VBA Verweise erstellen

Hallo!

Ich habe folgendes (riesiges) Problem:

Der Aufbau meines Arbeitsblattes sieht wie folgt aus:

Ich habe ein Tabellenblatt ("Mitarbeiter"), in dem in Spalte A alle Mitarbeiter (alphabetisch) stehen.
Dazu kommt, dass jeder Mitarbeiter ein eigenes Tabellenblatt hat, welches den selben Namen trägt, der seinem Namen entspricht, sprich dem Wert in Spalte A vom Tabellenblatt "Mitarbeiter". (diese werden automatisch erstellt)

Wenn nun ein neuer Mitarbeiter erstellt wird, werden im TB "Mitarbeiter" in die Spalte D und E werden Daten eingetragen.

Nun möchte ich einen VERWEIS herstellen, dass die Daten vom TB "Mitarbeiter"/Spalte D in das neue Tabellenblatt Zelle L12 eingetragen werden (und wenn später im TB "Mitarbeiter" Veränderungen sind, sollen auch diese dann übernommen werden)
Das selbe soll auch mit TB "Mitarbeiter"/Spalte E in neue Tabellenblatt Zelle I12 passieren

zusätzlich sollen vom neuen Tabellenblatt Daten aus der Zelle F10 ins TB "Mitarbeiter"/Spalte G geschrieben werden (und wieder, wenn sich im neuen TB was ändert soll das im TB "Mitarbeiter" auch geändert werden)
das selbe soll soll auch mit der Zelle F9 ins ins TB "Mitarbeiter"/Spalte H passieren

Kann mir jemand bei dem Code helfen? ich komme gar nicht zurecht. =(

Lg Mike

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 148450

Url: https://administrator.de/forum/vba-verweise-erstellen-148450.html

Ausgedruckt am: 24.12.2024 um 03:12 Uhr

52 Kommentare

Neuester Kommentar

Hallo xaumichi!

Es wäre vielleicht hilfreich, wenn du den Code für das Erstellen der TB posten würdest, dann könnte man diesen sofort abändern.

Mathe172

kein Problem:

Private Sub CommandButton1_Click()

Dim lngZeile As Long
Dim Jetztblatt As String

If Userform2.TextBox1 = "" Or Userform2.TextBox2 = "" Or Userform2.TextBox3 = "" Or Userform2.TextBox4 = "" Or Userform2.TextBox5 = "" Or Userform2.TextBox6 = "" Then  
Frame1.Caption = "Fehlende Felder"  
Frame1.ForeColor = RGB(255, 0, 0)

    If Userform2.TextBox1 = "" Then  
        Userform2.Label2.ForeColor = RGB(255, 0, 0)
    End If

    If Userform2.TextBox2 = "" Then  
        Userform2.Label1.ForeColor = RGB(255, 0, 0)
    End If

    If Userform2.TextBox3 = "" Then  
        Userform2.Label4.ForeColor = RGB(255, 0, 0)
    End If
    
    If Userform2.TextBox4 = "" Then  
        Userform2.Label5.ForeColor = RGB(255, 0, 0)
    End If

    If Userform2.TextBox5 = "" Then  
        Userform2.Label3.ForeColor = RGB(255, 0, 0)
    End If

    If Userform2.TextBox6 = "" Then  
        Userform2.Label6.ForeColor = RGB(255, 0, 0)
    End If

Else

Sheets("Client").Visible = True  
Sheets("Client").Select  
Sheets("Client").Copy After:=Sheets(Sheets.Count)  
ActiveSheet.name = Userform2.TextBox2 & " " & Userform2.TextBox1  
ActiveSheet.Protect "test"  
ActiveSheet.Range("C4") = ActiveSheet.name 'Name in Blatt einfügen  
Frame1.Caption = "Anmeldung"  
Frame1.ForeColor = RGB(0, 0, 0)
Sheets("Client").Visible = False  
Userform2.Label1.ForeColor = RGB(0, 0, 0)
Userform2.Label2.ForeColor = RGB(0, 0, 0)
Userform2.Label3.ForeColor = RGB(0, 0, 0)
Userform2.Label4.ForeColor = RGB(0, 0, 0)
Userform2.Label5.ForeColor = RGB(0, 0, 0)
Userform2.Label6.ForeColor = RGB(0, 0, 0)
Userform2.Hide

   
   ' Schreibt den Inhalt der Userform in die Excel Tabelle History  
   With Worksheets("Mitarbeiter")  
      lngZeile = IIf(Len(.Cells(.Rows.Count, 1)), .Rows.Count, .Cells(.Rows.Count, 1).End(xlUp).Row) + 1
      If lngZeile > .Rows.Count Then
         MsgBox "VOLL!"  
         Exit Sub
      End If
      
    
      Worksheets("Mitarbeiter").Cells(lngZeile, 1).Value = Userform2.TextBox2 & " " & Userform2.TextBox1  
      Worksheets("Mitarbeiter").Cells(lngZeile, 2).Value = Userform2.TextBox3  
      Worksheets("Mitarbeiter").Cells(lngZeile, 3).Value = Userform2.TextBox4  
      Worksheets("Mitarbeiter").Cells(lngZeile, 4).Value = Userform2.TextBox5  
      Worksheets("Mitarbeiter").Cells(lngZeile, 5).Value = Userform2.TextBox6  
      Worksheets("Mitarbeiter").Cells(lngZeile, 6).Value = Userform2.TextBox6  
     ' Worksheets("Mitarbeiter").Cells(lngZeile, 7).Formula = "=Worksheet(ActiveSheet.name)!F10"        --> funktioniert nicht   
      'Worksheets("Mitarbeiter").Cells(lngZeile, 8).Formula = "=Worksheet(ActiveSheet.name)!F9"          --> funktioniert nicht  
      
      With ActiveWorkbook.Worksheets("Mitarbeiter").Sort  
        .SetRange Range("A2:K21")  
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
        Worksheets("Mitarbeiter").Select  
        Range("A2").Select  
    End With
            
End If
End Sub

Hallo xaumichi!

Versuchs mal damit:

 Worksheets("Mitarbeiter").Cells(lngZeile, 7).Formula = "=" & Worksheet(ActiveSheet.name) & "!F10"     --> Variable oder Wert ausserhalb der "" und die drei Blöcke ("="; Worksh....name); "!F10") mit " & " verbinden (ohne die "")   

Mathe172

Danke...funktioniert aber leider nicht:

Fehler beim kompilieren:

Sub- oder Function nicht definiert

Lg Mike

Hallo xaumichi!

Sorry...
Vom Worksheets("Activesheet.name") brauchst du nur Activesheet.name, den Rest kannst du löschen.
Den Rest brauchst du nur wenn du Eigenschaften der Tabelle oder derer Inhalte definieren willst. Der Tabellenname steht wie der Name sagt in Activesheet.name. (Damit sagst du dem Programm: Gib mir den Namen der Aktuellen Tabelle; Das andere heisst in etwaIch will etwas in der Tabelle mit dem Namen der aktuellen Tabelle ändern)

Mathe172

P.S:Hoffe die erklärung ist verständlich

Jup, verstanden! =)

So, nun steht zwar die richtige Formel in der Tabelle. allerdings bekomme ich als Ausgabe nur #Name?

Habe herausgefunden, dass das darum kommt, da ein Leerzeichen im Tabellennamen ist.
Wie kann ich dies noch hineinbringen?

LG

EDIT:

Habs geschafft, hab noch ein " ' " vor und nach dem ActiveSheet drangemacht! =)

Noch was, wie schaff ich es, dass ich nicht eine Verweis mache von Personen-TB --> "Mitarbeiter" sonder umgekehrt??

LG

Hallo xaumichi!

Versuchs mal damit:

 Worksheet("ActiveSheet.name").[L12].Formula = "=" & 'Mitarbeiter' & "!D" & 'lngZeile'   

Mathe172

cool, muss ich mal ausprobieren! =)

EDIT: Hm....funktioniert leider nicht.
Das mit dem Tabellenblatt "Mitarbeiter" passen nicht und du hast wieder eine "Worksheet" vorm "Activesheet.name" ;)
wenn man im Debug-Modus mit der Maus über "Mitarbeiter" fährt, steht da "Mitarbeiter=leer". Hilft das vl?

Könnte mir noch wer helfen

=WENN(A1>A2;"-"&TEXT(A1-A2;"[hh]:mm");TEXT(A2-A1;"[hh]:mm")) in

 Worksheets("Mitarbeiter").Cells(lngZeile, 7).Formula = "=" & "'" & ActiveSheet.name & "'" & "!F10"  

( "=" & "'" & ActiveSheet.name & "'" & "!F10")
einzugeben?? :S

Hallo xaumichi!

Sorry, ich habs wohl ein bisschen zu schnell gemacht. Meine Fehler:

Es muss Worksheets und nicht Worksheet heissen (Diesmal will ich ja eine Eigenschaft eines "Dings" in der aktuellen Tabelle ändern: Die Formel aus L12)
Eine Variable darf nicht in "" stehen:-->Sheets(Activesheet.name)
Mitarbeiter ist keine Variable(darum auch "Mitarbeiter=leer"), sondern ein fixer Name einer Tabelle:-->nicht zwischen & schreiben
Das mit den ' brauchts bei mir nicht (probiers wenn nicht tut trotzdem mit)

Das sollte jetzt funktionieren(wenn nicht bin ich wahrscheinlich zu blöd):

 Worksheets(ActiveSheet.name).[L12].Formula = "=Mitarbeiter!D" & lngZeile

Das andere schau ich noch an

Mathe172

:D toll funktioniert! Danke!!!

Hallo xaumichi!

Beim zweiten hätte ich alles, nur bringt er einen Fehler wenn ich ="=Formel" schreibe. Aus irgendeinem Grund funktioniert aber ="Formel" oder sogar =" =Formel" (also mit Leerzeichen) schreibe. Aber in beiden funktionierenden Fällen funktioniert ja das Endprodukt nicht.

Die Vorläufige Lösung wäre:

Worksheets("Mitarbeiter").Cells(lngZeile, 7).Formula = "=WENN(" & ActiveSheet.name & "!A1>" & ActiveSheet.name & "!A2;"-"&TEXT(" & ActiveSheet.name & "!A1-" & ActiveSheet.name & "!A2;""[hh]:mm"");TEXT(" & ActiveSheet.name & "!A2-" & ActiveSheet.name & "!A1;""[hh]:mm""))"  

Hoffe ich habe keinen Tippfehler gemacht.

Mathe172

Hallo!

Habs probiert. Leider hats es nicht geklappt!

Hab mich mit der Formel ansicht noch mal gespielt, und konnte sie ein bisschen vereinfachen:

=WENN(Q2<0;"-"&TEXT(Q2;"[hh]:mm");TEXT(Q2;"[hh]:mm"))

Hallo!

Auf welche Tabelle kommt die Formel, wo ist Q2?
Ist es wie oben die Formel auf Mitarbeiter, Q2 auf der ActiveSheet?

Mathe172

Jup, es ist alles gleich, nur statt dem A1 und A2 gibts jetzt einen Vergleich mit Q2<0!

Also das Problem hab ich gefunden, aber keine Lösung. Vielleicht weiss sonst jemand wie man das verändern muss:

Worksheets(Activesheet.name).[A1].Formula= "=;"

Bei mir kommt immer:
Laufzeitfehler '1004':

Anwendungs- oder Objektdefinierten Fehler

Mathe172

Hm...schade, aber trotzdem danke für den Versuch! =)

Hallo noch mal!

Hab jetzt die richtige Syntax!

Dim ShName As String

        ShName = ActiveSheet.name

        '=IF(Tabelle2!Q2<0,"-"&TEXT(Tabelle2!Q2,"[hh]:mm"),TEXT(Tabelle2!Q2,"[hh]:mm"))  
        Worksheets("Mitarbeiter").Cells(lngZeile, 7).Formula = _  
        "=IF(" & "'" & ShName & "'" & "!Q2/24<0,""-""&TEXT(" & "'" & ShName & "'" & "!Q2/24*-1,""[hh]:mm""),TEXT(" & "'" & ShName & "'" & "!Q2/24,""[hh]:mm""))"  

hab ich von http://www.office-loesung.de/ftopic402717_0_0_asc.php

LG Mike

Hallo xaumichi!

Das Problem in Codezeile 70 und 71 ist, dass Du in den Tabellennamen ein Lehrzeichen hast. Indem Fall musst Du den Namen in einfache Hochkommata setzen (siehe Code)

Bei der Gelegenheit habe ich Deinen Anfangs-Code etwas reduziert, wobei Du allerdings in Deiner UserForm im Eigenschaftsfenster, die Labelnamen der TextBoxen entsprechend anpassen musst (TextBox1 und Label1, TextBox2 und Label2....).

Option Explicit

Const FarbeRot = &HFF
Const FarbeSchwarz = 0

Private Sub CommandButton1_Click()
    Dim lngZeile As Long, Jetztblatt As String, Fehler As Boolean, i As Integer
    
    For i = 1 To 6
        UserForm2("Label" & (i)).ForeColor = FarbeSchwarz  'Falls nicht alle berichtigt wurden  
        If UserForm2("TextBox" & i) = "" Then  
            Fehler = True:  UserForm2("Label" & (i)).ForeColor = FarbeRot  
        End If
    Next
    
    If Fehler Then
        Frame1.Caption = "Fehlende Felder"  
        Frame1.ForeColor = FarbeRot
    Else
        Application.ScreenUpdating = False
        
        With Sheets("Client")  
            .Visible = True
            .Copy After:=Sheets(Sheets.Count)
            .Visible = False
        End With

        With ActiveSheet
            .Name = UserForm2.TextBox2 & " " & UserForm2.TextBox1  
            .Range("C4") = .Name  
            .Protect Password:="test"  
        End With
        
        'Farbe auf schwarz zurücksetzen ist unnötig, weil Userform geschlossen wird (Unload anstatt Hide)  
        'Frame1.Caption = "Anmeldung"  
        'Frame1.ForeColor = FarbeSchwarz  
        'For i = 1 To 6:  UserForm2("Label" & i).ForeColor = FarbeSchwarz:  Next  
        
        With Worksheets("Mitarbeiter")  
            lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
            
            If lngZeile = 1 Then
                If Not IsEmpty(.Cells(1, 1)) Then lngZeile = lngZeile + 1
            ElseIf lngZeile < .Rows.Count And IsEmpty(.Cells(.Rows.Count, 1)) Then
                lngZeile = lngZeile + 1
            Else
                MsgBox "VOLL!":  Exit Sub  
            End If
            
            With .Cells.Rows(lngZeile)
                .Columns(1) = TextBox2 & " " & TextBox1  
                .Columns(2) = TextBox3
                .Columns(3) = TextBox4
                .Columns(4) = TextBox5
                .Columns(5) = TextBox6
                .Columns(6) = TextBox6
                .Columns(7).Formula = "='" & ActiveSheet.Name & "'!F10"  
                .Columns(8).Formula = "='" & ActiveSheet.Name & "'!F9"  
            End With
            
            Range(.Range("A2"), .Cells(lngZeile, "K")).Sort Key1:=.Range("A2"), Header:=xlNo  
         
           .Activate:  Range("A2").Select  
            
            Application.ScreenUpdating = True
           
            Unload Me
        End With
    End If
End Sub

Gruß Dieter

[edit]
Codezeile 61 von

           .Range("A2:K21").Sort Key1:=.Range("A2"), Header:=xlNo

nach

            Range(.Range("A2"), .Cells(lngZeile, "K")).Sort Key1:=.Range("A2"), Header:=xlNo  

geändert.

Für den Fall, dass es mehr als als 20 Mitarbeiter werden. Jetzt bis letzte Zeile mit Inhalt.
[/edit]

Hallo!

So, jetzt nach einer kurzen Testphase ist mir ein seltsamer Fehler aufgefallen:

Ansich funktioniert der Code ganz gut, NUR:

Kurze Beschreibung:
Diese "activeSheet.Name" bezieht sich ja auf einen neu erstellten Mitarbeiter, der in einer Tabelle hinzugefügt wird. Diese Liste wird nach dem Erstellen alphabtisch geordnet. Wird nun ein Mitarbeiter erstellt, der alphabetisch VOR allen aneren steht, da er alphabetisch er erste ist, so wird bei der Wert nicht von diesem Mitarbeiter verwendet, sondern die, des Vorgängener.

Warum ist dem so??

LG Mike

Hallo Mike!

Zitat von @xaumichi:
So, jetzt nach einer kurzen Testphase ist mir ein seltsamer Fehler aufgefallen:

Ansich funktioniert der Code ganz gut, NUR:

Kurze Beschreibung:
Diese "activeSheet.Name" bezieht sich ja auf einen neu erstellten Mitarbeiter, der in einer Tabelle hinzugefügt
wird. Diese Liste wird nach dem Erstellen alphabtisch geordnet. Wird nun ein Mitarbeiter erstellt, der alphabetisch VOR allen
aneren steht, da er alphabetisch er erste ist, so wird bei der Wert nicht von diesem Mitarbeiter verwendet, sondern die, des
Vorgängener.

Verstehe ich nicht ganz? Welcher Wert?

Und bei dieser Gelegenheit, ab welcher Zeile beginnt die Mitarbeiter-Liste, ab Zeile 2 (Zeile1 Überschrift?)?

Gruß Dieter

Naja, ich hab ja ein paar Eintragungen oberhalb eine funktionierende Syntax hereinkopiert, mit der man auf dem "ActiveSheet.Name" ein Verweis eingefügt wird.
Hier kommt der Ausdruck "lngZeile" vor (Def. siehe ganz oben, Zeile 56!). Hier wird eben ein Wert eingetragen, der dann auf dem "ActiveSheet.Name" eingetragen werden soll.
Jetzt passiert es aber, dass, wenn ein Name bereits in der Liste (im Tabellenblatt "Mitaribeiter") steht und nun ein weiterer Name hinzugefügt wird, der alphabetisch vor dem eingetragenen stehen wird, dass dann dessen Wert eingetragen wird und nicht der, des neu erstellen Mitarbeiters!

Jup, beginnen tuts bei Zeile 2, 1 sind Überschriften!

LG

Hallo Mike!

Achso

Aber eigentlich sollte das nicht passieren, weil Du ja bis Spalte K sortierst und die Verweise sich mit Spalte 7 und 8 innerhalb dieses Bereichs befindet. Da habe ich leider keine Erklärung dafür

Gruß Dieter

Hallo nochmal!

Also, ich habe mal mit meinem Code getestet und konnte keinen Sortier-Fehler erkennen

Im Code oben, habe ich den Sortiervorgang auf Range A2:K & "Letzt Zeile mit Inhalt" geändert.

Gruß Dieter

Hm...okey!

dann versuch ich den deinen mal! =)

wieweit ersetz dein Code meinen Code?

LG

Hallo Mike!

Von der Funktion her gesehen gleich, aber etwas zusammengefasst.

Aber vorher erst die ersten Zeilen nochmal durchlesen. UserForm-Labels namentlich (1,2,3,4,5,6) den TextBoxen anpassen

Gruß Dieter

Ich pack es nicht...!

Habs jetzt mal probiert....und jetzt passiert folgendes.

Erster Mitarbeiter funktioniert wieder einwandfrei, füge ich jetzt einen neuen Mitarbeiter ein, der VOR dem bestehenen kommt, so bekommt der bestehene Mitarbeiter den Wert des neuen und der neu den Wert des alten Mitarbeiters.

PS: ich habe die Zeile 57 noch geändert, damit die richtige Formel drinnen steht:

 .Columns(7).Formula = "=IF(" & "'" & ActiveSheet.name & "'" & "!Q2/24<0,""-""&TEXT(" & "'" & ActiveSheet.name & "'" & "!Q2/24*-1,""[hh]:mm""),TEXT(" & "'" & ActiveSheet.name & "'" & "!Q2/24,""[hh]:mm""))"   

Ich verstehs nicht, was ich anderes mache....!

Lg

Könnte es damit zu tun haben, dass die Spalten E:H geschützt sind?

[/Edit]

Hallo Mike!

Wie , die Zellen sind geschützt? Meinst Du damit, dass in der Tabelle "Mitarbeiter" während der Neu-Erstellung der Blattschutz aktiv ist. Wenn die Spalte(5) E bis Spalte(8) H gesperrte Zellen sind, dann können diese nicht beschrieben werden. Bekommst Du denn keine Fehlermeldung? Normalerweise bekommt man eine Fehlermeldung, wenn versucht wird, Werte in geschützte Zellen zu schreiben.

Gruß Dieter

Diese sind geschützt, ja.
Das Passwort für das Tabellenblatt ist unter "DiesesArbeitsblatt" definiert. Darum funktioniert auch die Eintragung.
Hab es auch schon probiert, den Schutz zu entfernen. Hat aber vom Ergebniss nichts geändert:

Der erste Eintrag funktioniert und jeder Eintrag, der alphabetisch vorher kommt (nach der Sortierung) bekommt in .Columns(7) den Wert des Vorängers und umgekehrt!
=(

LG

Hallo nochmal!

Zitat von @xaumichi:
Das Passwort für das Tabellenblatt ist unter "DiesesArbeitsblatt" definiert.

Nun, dass verstehe ich jetzt leider überhaupt nicht ?????????

Also, die Formel ist so in Ordnung, wenn man mal davon absieht, dass unnötige & drinnen sind. Könnte auch so lauten:

.Columns(7).Formula = "=IF('" & ActiveSheet.Name & "'!Q2/24<0,""-""&TEXT('" & ActiveSheet.Name & "'!Q2/24*-1,""[hh]:mm""),TEXT('" & ActiveSheet.Name & "'!Q2/24,""[hh]:mm""))"  

Gruß Dieter

Naja, laut eines Formus, bewirkt diese Zeile:

ThisWorkbook.Worksheets("Mitarbeiter").Protect Password:="test", UserInterFaceOnly:=True  

das jetzt das Tabellenblatt "Mitarbeiter" durch Makros bearbeitet werden kann. Was ja auch soweit funktioniert.....

Hallo Mike!

Aja, dass wusste ich jetzt nicht

ich werde mal mit Formeln testen

Die habe ich ja bisher noch nicht in den Code integriert.

Gruß Dieter

Hui, das freut mich aber, dass "ich" dir auch was neues zeigen hab können!

Okey, danke!

LG Mike

Hallo nochmal!

Zitat von @xaumichi:
Hui, das freut mich aber, dass "ich" dir auch was neues zeigen hab können!

Ja, man kann halt nicht alles wissen

Also, ich habe jetzt meinen Code nochmal mit Formel getestet. Leider mit dem Ergebnis, dass alles stimmt

Gruß Dieter

Und nochmal Hallo!

Mach mal vor dem Sort ein Kommentarzeichen und schau, ob die Einträge stimmen. Habe da gerade einen Verdacht

Gruß Dieter

Naja, jetzt würde alles stimmen.

Wär eben so, als ob bei der Eintrag nachgestellt werden würde!

Hm...werden die die Zeilen vl nicht mitsortiert??

Lg mike

Hallo Mike!

Das Problem liegt beim Sortieren. Und zwar werden Sortier-Einstellungen gespeichert und beim nächsten Sortier-Befehl eben diese Einstellungen übernommen, D.h. alle nötigen Einstellungen müssen explizit angegeben werden. Habe gerade mal mit mehreren Parameter herumexperementiert und da passieren ganz kommische Sachen. Am besten Du machst mal ein paar Eingaben ohne die Codezeile Sort und sortierst manuell über das <Menu><Daten> mit Makroaufzeichnung. Wenn falsch, dann kannst Du ja über die Undo-Funktion die Sortierung rückgängig machen....

Gruß Dieter

Okey, werde ich morgen dann probieren!

Danke für deine Bemühungen! =)

Schönen Abenden noch!

LG Mike

Versuchs mal damit:

            Range(.Range("A2"), .Cells(lngZeile, "K")).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo, _  
                                 Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal

Gruß Dieter

Hm...hat leider auch nicht funktioniert.
Er nimmt den Wert des Letzten in meiner Liste! =(

LG Mike

[EDIT:]
Hab jetzt versucht, ein Makro mit dieser Liste zu erstellen und dieses Makro dann einzufügen, hat jedoch auch kein andere Ergebnis geliefert....!

Guten Morgen!

Zitat von @xaumichi:
Schönen Abenden noch!

Da ist leider nicht viel von übrig geblieben

Hast Du die Nacht durchgemacht?

Mhm, es liegt ja eindeutig am Sort-Befehl und das der trotz umfangreicher Parameter-Einstellungen bei Dir immer noch nicht funktioniert, ist mir ein Rätsel

, zumal es bei mir ja einwandfrei geht?

Und wenn Du manuell über's Menü sortierst, funktioniert es auch nicht? Und die Sortierdaten befinden sich alle im Bereich von Spalte A:K?

Gruß Dieter

PS. Hast Du auch mal in einer anderen Excel-Version getestet?

Hallo Mike!

Versuchs mal mit diesem Code:

Option Explicit

Const FarbeRot = &HFF
Const FarbeSchwarz = 0

Private Sub CommandButton1_Click()
    Dim Fehler As Boolean, NeuZeile As Long, i As Integer
    
    For i = 1 To 6
        UserForm2("Label" & (i)).ForeColor = FarbeSchwarz  'Falls nicht alle berichtigt wurden  
        If UserForm2("TextBox" & i) = "" Then  
            Fehler = True:  UserForm2("Label" & (i)).ForeColor = FarbeRot  
        End If
    Next
    
    If Fehler Then
        Frame1.Caption = "Fehlende Felder"  
        Frame1.ForeColor = FarbeRot
    Else
        Application.ScreenUpdating = False
        
        With Sheets("Client")  
            .Visible = True
            .Copy After:=Sheets(Sheets.Count)
            .Visible = False
        End With

        With ActiveSheet
            .Name = UserForm2.TextBox2 & " " & UserForm2.TextBox1  
            .Range("C4") = .Name  
            .Protect Password:="test"  
        End With
        
        With Worksheets("Mitarbeiter")  
            NeuZeile = GetLine(ActiveSheet.Name)
            
            If NeuZeile = 0 Then MsgBox "VOLL!":  Exit Sub  
            
            With .Cells.Rows(NeuZeile)
                .Columns(1) = TextBox2 & " " & TextBox1  
                .Columns(2) = TextBox3
                .Columns(3) = TextBox4
                .Columns(4) = TextBox5
                .Columns(5) = TextBox6
                .Columns(6) = TextBox6
                .Columns(7).Formula = "=IF('" & ActiveSheet.Name & "'!Q2/24<0,""-""&TEXT('" & ActiveSheet.Name & _  
                                      "'!Q2/24*-1,""[hh]:mm""),TEXT('" & ActiveSheet.Name & "'!Q2/24,""[hh]:mm""))"  
                .Columns(8).Formula = "=" & "'" & ActiveSheet.Name & "'!F9"  
            End With
            
            Range("L12").Formula = "=VLOOKUP(C4,Mitarbeiter!A:D,4,FALSE)"  

           .Activate:  Range("A2").Select  
            
            Application.ScreenUpdating = True
           
            Unload Me
        End With
    End If
End Sub

Private Function GetLine(ByRef Mitarbeiter) As Long
    Dim i As Long, EndLine As Long

    With Worksheets("Mitarbeiter")  
        EndLine = .Cells(.Rows.Count, "A").End(xlUp).Row  
            
        GetLine = EndLine + 1
        
        If EndLine = 1 Then
            If Not IsEmpty(.Cells(1, "A")) Then EndLine = 2:  GetLine = 2  
        ElseIf Not IsEmpty(.Cells(.Rows.Count, "A")) Then  
            GetLine = 0:  Exit Function
        End If
    
        For i = 2 To EndLine
            If Not IsEmpty(.Cells(i, "A")) Then  
                If StrComp(Mitarbeiter, .Cells(i, "A"), vbTextCompare) = True Then  
                    Range(.Cells(i, "A"), .Cells(EndLine + 1, "K")).Cut .Cells(i + 1, "A")  
                    GetLine = i:  Exit Function
                End If
            End If
        Next
    End With
End Function

Die Funktion GetLine gibt entweder 0 (Fehler voll) oder die Zeilennumer, in der der Mitarbeiter eingefügt wird, zurück. In der Mitarbeiterliste wird die entsprechende Zeile nach alphabetischer Reihenfolge gesucht und dem entsprechend eine Leerzeile für den neuen Mitarbeiter eingefügt.

Jetzt bin ich mal gespannt, ob das bei Dir funktioniert

Wenn nicht, dann hast Du irgendwo anders einen Bock drinnen?

Ist das Mitarbeiterblatt das Blatt mit der Worksheet_Change-Routine?

Gruß Dieter

[edit]
Code entsprechend den Bedingungen der nachfolgenden Kommentare geändert:
SVerweisFormel für das neue Mitarbeiterblatt hinzugefügt.
In Funktion GetLine(...) - Verschiebung der Zellinhalte nur von Spalte A-K
[/edit]

Hallo!

Nein, habe nicht durchgemacht, sondern hab früh beginnen müssen heute!

So, hab jetzt deinen Code ausprobiert.

Leider wird jetzt der Wert (der vorher immer falsch eingetragen wurde) gar nicht eingetragen.

Hab mir den Code noch mal angesehen und habe festgestellt, dass irgendwie die Zeile:

Worksheet("ActiveSheet.name").[L12].Formula = "=" & 'Mitarbeiter' & "!D" & 'lngZeile'   

fehlt, oder hab ich die wo übersehen?

LG Mike

[Edit]

So, hab jetzt die Zeile noch hinzugefügt! =)
Funktioniert!! :D

NUR:

durch diese Methode wird die Formatierung der erse Zeile (mit den Überstunden) übernommen, daass ist schlecht, da hier alle Zellen gesperrt sind, andere Schriftart,...!
Und es werden dadurch ActiveX-Element verschoben...!

Hallo Mike!

Kommentar entfernt, steh im Moment irgendwie auf der Leitung

Gruß Dieter

Okey!

Ich/wir probiern jetzt schon so lange herum, dass es auf ein paar stunden mehr oder weniger auch nicht mehr drauf ankommt!

Hallo nochmal!

Zitat von @xaumichi:
Leider wird jetzt der Wert (der vorher immer falsch eingetragen wurde) gar nicht eingetragen.
Hab mir den Code noch mal angesehen und habe festgestellt, dass irgendwie die Zeile:

Worksheet("ActiveSheet.name").[L12].Formula = "=" & 'Mitarbeiter' &  
> "!D" & 'lngZeile'   

fehlt, oder hab ich die wo übersehen?

Diese Formel ist mir gänzlich unbekannt und syntaktisch auch falsch.

Wenn ich es aber richtig verstehe, dann soll in den neuen Mitarbeiterblätter eine Formel mit einem Bezug auf das Sheet("Mitarbeiter") eingefügt werden und in diesem Fall wäre es dann auch erklärbar, warum der Sortierbefehl nicht so funktioniert, wie Du Dir das vorstellst. Die Bezüge in den Mitarbeitblättern werden beim sortieren logischerweise willkürlich verschoben

Indem Fall darf entweder nicht sortiert werden, oder in allen Mitarbeiterblättern, muss der Bezug neu angepasst werden

Bei meiner Einfügmethode, werden die Bezüge automatisch angepasst. Das sollte aber eigentlich nur einem Test dienen, ob da irgendetwas anderes schief läuft. Und da mir die Formel bisher nicht bekannt war, konnte ich natürlich auch keine Erklärung für das Disaster finden.

Gruß Dieter

PS. Das mit meiner Einfügfunktion die Spalten ab Spalte L nicht verschoben werden, muss ich erst noch austesten.

Okey.
Diese Formel wird im Thread weiter oben abgehandelt!

Hm....aber hast du einen Weg gefunden, dass die neuen Mitarbeiter die selbe Formatierung haben, wie die anderen, bzw. dass die ActiveX-Elemente (M3, M6, M8) nicht verschoben oder gezerrt werden?

Lg Mike

PS:Okey, habs erst jetzt gelesen!

Hallo Mike!

Füge nach Codezeile 30 (.Range("C4") = .Name ) diese Codezeile ein.

            .Range("L12").Formula = "=VLOOKUP(C4,Mitarbeiter!A:D,4,FALSE)"

Das ergibt dann in den Mitarbeiterblätter einen SVerweis auf das Sheet("Mitarbeiter"). SVerweis sucht im Sheet("Mitarbeiter") in Spalte A nach dem Namen, der in den Mitarbeiterblättern in der Zelle C4 (siehe Codezeile) eingetragen wurde und zeigt den Wert aus Spalte D an. Dadurch kann dann wieder der Sortierbefehl verwendet werden

Gruß Dieter

Kann es sein, dass das dieser Code für Zeile 31 noch "zu früh" ist?
Den das Problem ist, wenn ich den Code bereit in Zeile 31 stehen haben, soll der Wert vom Tabellenblatt "Mitarbeiter" übertragen werden, wo noch gar kein Eintrag steht. Darum bekomm ich im neu erstellten Tabellenblatt auf L12 einen #NV und eine Fehlermeldung :

Laufzeitfehler:

Unverträgliche Typen

:-S

Lg mike

Hallo Mike!

Diesen Code, wieder mit Sort-Befehl und SVerweis-Formel:

Option Explicit

Const FarbeRot = &HFF
Const FarbeSchwarz = 0

Private Sub CommandButton1_Click()
    Dim Fehler As Boolean, NeueZeile As Long, i As Integer
    
    For i = 1 To 6
        UserForm2("Label" & (i)).ForeColor = FarbeSchwarz  'Falls nicht alle berichtigt wurden  
        If UserForm2("TextBox" & i) = "" Then  
            Fehler = True:  UserForm2("Label" & (i)).ForeColor = FarbeRot  
        End If
    Next
    
    If Fehler Then
        Frame1.Caption = "Fehlende Felder"  
        Frame1.ForeColor = FarbeRot
    Else
        Application.ScreenUpdating = False
        
        With Sheets("Client")  
            .Visible = True
            .Copy After:=Sheets(Sheets.Count)
            .Visible = False
        End With

        With ActiveSheet
            .Name = UserForm2.TextBox2 & " " & UserForm2.TextBox1  
            .Range("C4") = .Name  
            .Protect Password:="test", UserInterFaceOnly:=True  
        End With
        
        With Worksheets("Mitarbeiter")  
            NeueZeile = .Cells(.Rows.Count, "A").End(xlUp).Row  
            
            If NeueZeile = 1 Then
                If Not IsEmpty(.Cells(1, "A")) Then NeueZeile = 2  
            ElseIf Not IsEmpty(.Cells(.Rows.Count, "A")) Then  
                MsgBox "VOLL!":  Exit Sub  
            Else
                NeueZeile = NeueZeile + 1
            End If
            
            With .Cells.Rows(NeueZeile)
                .Columns(1) = TextBox2 & " " & TextBox1  
                .Columns(2) = TextBox3
                .Columns(3) = TextBox4
                .Columns(4) = TextBox5
                .Columns(5) = TextBox6
                .Columns(6) = TextBox6
                .Columns(7).Formula = "=IF('" & ActiveSheet.Name & "'!Q2/24<0,""-""&TEXT('" & ActiveSheet.Name & _  
                                      "'!Q2/24*-1,""[hh]:mm""),TEXT('" & ActiveSheet.Name & "'!Q2/24,""[hh]:mm""))"  
                .Columns(8).Formula = "=" & "'" & ActiveSheet.Name & "'!F9"  
            End With
            
            Range(.Range("A2"), .Cells(NeueZeile, "K")).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo, _  
                                 Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal
           
            Range("L12").Formula = "=VLOOKUP(C4,Mitarbeiter!A:D,4,FALSE)"  
            
           .Activate:  Range("A2").Select  
            
            Application.ScreenUpdating = True
           
            Unload Me
        End With
    End If
End Sub

Wenn der jetzt nicht endlich funktioniert, dann springe ich vom Balkon

Gruß Dieter

[edit] Auf Anregung von xaumichi, die SVerweis-Formel nach Zeile 60 verschoben [/edit]

Naja, wär doch schade!

Also, ich habe nun die Zeile 31 (aus deinem gerade eben geposteten Code) in die Zeile 57 mit

Activesheet....

zu Beginn verschoben und ....
ES FUNKTIONIERT!!!

Danke, viel mals!!!

Lg Mike

Hallo Mike!

Zitat von @xaumichi:
Naja, wär doch schade!

Also, ich habe nun die Zeile 31 (aus deinem gerade eben geposteten Code) in die Zeile 57 mit

Naja, ist ja nur ne Kleinigkeit und im Eifer des Gefechts passieren solche Unachtsamkeiten schon mal

Freut mich aber, dass Du dieses Problem von selbst lösen konntest

Und Gottseidank funktioniert es endlich!!!!!!

Gruß Dieter

PS.
Hab's im letzten Code geändert, allerdings nach Sort in Codezeile 60 verschoben. Neues Sheet ist noch das ActiveSheet, insofern reicht nur Range ohne Punkt.
Und den Code mit der Einfüg-Funktion GetLine(..) habe ich auch entsprechend angepasst. Verschiebt jetzt nur noch Spalte A-K und würde somit jetzt auch seinen Zweck erfüllen.

gelöst Frage Microsoft Microsoft Office

Mehr von xaumichi

Serienbrief Aufzählungspunkte steuernxaumichi - 7 Kommentare

Bildschirm auf PC Datenübertragung fehlerhaftxaumichi - 6 Kommentare

Zeileneinzug seitenabhängigxaumichi - 3 Kommentare

C-Sharp-Programm nachträglich websidetauglich machenxaumichi - 2 Kommentare

Heiß diskutiert