xaumichi
Aug 05, 2010
view6104
view52
0
Goto Top

VBA Verweise erstellen

GermansolvedQuestionMicrosoft OfficeMicrosoft
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 148450

Url: https://administrator.de/contentid/148450

Printed on: April 26, 2024 at 00:04 o'clock

52 Comments
Latest comment
Goto Top
Member: mathe172
mathe172 Aug 05, 2010 at 16:45:22 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 05, 2010 at 17:15:06 (UTC)
Goto Top
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
Member: mathe172
mathe172 Aug 05, 2010 at 18:32:59 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 05, 2010 at 18:45:46 (UTC)
Goto Top
Danke...funktioniert aber leider nicht:

Fehler beim kompilieren:

Sub- oder Function nicht definiert

Lg Mike
Member: mathe172
mathe172 Aug 05, 2010 at 18:54:55 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 05, 2010 at 19:30:18 (UTC)
Goto Top
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! =)
Member: xaumichi
xaumichi Aug 05, 2010 at 19:49:31 (UTC)
Goto Top
Noch was, wie schaff ich es, dass ich nicht eine Verweis mache von Personen-TB --> "Mitarbeiter" sonder umgekehrt??


LG
Member: mathe172
mathe172 Aug 05, 2010 at 20:10:00 (UTC)
Goto Top
Hallo xaumichi!

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

Mathe172
Member: xaumichi
xaumichi Aug 05, 2010 at 20:16:27 (UTC)
Goto Top
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
Member: mathe172
mathe172 Aug 06, 2010 at 09:46:30 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 06, 2010 at 09:55:25 (UTC)
Goto Top
:D toll funktioniert! Danke!!!
Member: mathe172
mathe172 Aug 06, 2010 at 10:34:44 (UTC)
Goto Top
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. face-wink

Mathe172
Member: xaumichi
xaumichi Aug 06, 2010 at 11:06:46 (UTC)
Goto Top
Hallo!

Habs probiert. Leider hats es nicht geklappt! face-sad
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"))
Member: mathe172
mathe172 Aug 06, 2010 at 11:12:30 (UTC)
Goto Top
Hallo!

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

Mathe172
Member: xaumichi
xaumichi Aug 06, 2010 at 11:18:19 (UTC)
Goto Top
Jup, es ist alles gleich, nur statt dem A1 und A2 gibts jetzt einen Vergleich mit Q2<0!
Member: mathe172
mathe172 Aug 06, 2010 at 12:11:35 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 06, 2010 at 15:42:16 (UTC)
Goto Top
Hm...schade, aber trotzdem danke für den Versuch! =)
Member: xaumichi
xaumichi Aug 07, 2010 at 22:54:33 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 09, 2010 at 11:22:25 (UTC)
Goto Top
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]
Member: xaumichi
xaumichi Aug 09, 2010 at 12:23:04 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 09, 2010 at 12:47:14 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 09, 2010 at 13:49:23 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 09, 2010 at 14:56:30 (UTC)
Goto Top
Hallo Mike!

Achsoface-wink

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ürface-sad

Gruß Dieter
Mitglied: 76109
76109 Aug 09, 2010 at 17:46:50 (UTC)
Goto Top
Hallo nochmal!

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

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

Gruß Dieter
Member: xaumichi
xaumichi Aug 09, 2010 at 18:10:25 (UTC)
Goto Top
Hm...okey! face-smile dann versuch ich den deinen mal! =)

wieweit ersetz dein Code meinen Code?

LG
Mitglied: 76109
76109 Aug 09, 2010 at 18:33:10 (UTC)
Goto Top
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 anpassenface-wink

Gruß Dieter
Member: xaumichi
xaumichi Aug 09, 2010 at 18:50:30 (UTC)
Goto Top
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....! face-sad

Lg

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

[/Edit]
Mitglied: 76109
76109 Aug 09, 2010 at 20:28:23 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 09, 2010 at 20:38:46 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 09, 2010 at 20:56:06 (UTC)
Goto Top
Hallo nochmal!

Zitat von @xaumichi:
Das Passwort für das Tabellenblatt ist unter "DiesesArbeitsblatt" definiert.
Nun, dass verstehe ich jetzt leider überhaupt nicht ?????????face-sad

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
Member: xaumichi
xaumichi Aug 09, 2010 at 20:59:21 (UTC)
Goto Top
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.....
Mitglied: 76109
76109 Aug 09, 2010 at 21:04:29 (UTC)
Goto Top
Hallo Mike!

Aja, dass wusste ich jetzt nichtface-smile

ich werde mal mit Formeln testenface-wink Die habe ich ja bisher noch nicht in den Code integriert.

Gruß Dieter
Member: xaumichi
xaumichi Aug 09, 2010 at 21:08:37 (UTC)
Goto Top
Hui, das freut mich aber, dass "ich" dir auch was neues zeigen hab können! face-wink

Okey, danke! face-smile

LG Mike
Mitglied: 76109
76109 Aug 09, 2010 at 21:20:43 (UTC)
Goto Top
Hallo nochmal!

Zitat von @xaumichi:
Hui, das freut mich aber, dass "ich" dir auch was neues zeigen hab können! face-wink
Ja, man kann halt nicht alles wissenface-smile

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

Gruß Dieter
Mitglied: 76109
76109 Aug 09, 2010 at 21:25:03 (UTC)
Goto Top
Und nochmal Hallo!

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

Gruß Dieter
Member: xaumichi
xaumichi Aug 09, 2010 at 21:33:02 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 09, 2010 at 21:51:26 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 09, 2010 at 22:00:09 (UTC)
Goto Top
Okey, werde ich morgen dann probieren!

Danke für deine Bemühungen! =)

Schönen Abenden noch!

LG Mike
Mitglied: 76109
76109 Aug 09, 2010 at 22:04:38 (UTC)
Goto Top
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
Member: xaumichi
xaumichi Aug 10, 2010 at 03:55:37 (UTC)
Goto Top
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....!
Mitglied: 76109
76109 Aug 10, 2010 at 06:04:24 (UTC)
Goto Top
Guten Morgen!

Zitat von @xaumichi:
Schönen Abenden noch!
Da ist leider nicht viel von übrig gebliebenface-smile

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ätselface-sad, 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?
Mitglied: 76109
76109 Aug 10, 2010 at 08:40:13 (UTC)
Goto Top
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 funktioniertface-wink 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]
Member: xaumichi
xaumichi Aug 10, 2010 at 17:42:43 (UTC)
Goto Top
Hallo!

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

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...! face-sad
Mitglied: 76109
76109 Aug 10, 2010 at 19:31:28 (UTC)
Goto Top
Hallo Mike!

Kommentar entfernt, steh im Moment irgendwie auf der Leitungface-smile

Gruß Dieter
Member: xaumichi
xaumichi Aug 10, 2010 at 19:43:52 (UTC)
Goto Top
Okey! face-smile

Ich/wir probiern jetzt schon so lange herum, dass es auf ein paar stunden mehr oder weniger auch nicht mehr drauf ankommt! face-smile
Mitglied: 76109
76109 Aug 10, 2010 at 20:24:12 (UTC)
Goto Top
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 verschobenface-wink

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

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.
Member: xaumichi
xaumichi Aug 10, 2010 at 20:38:47 (UTC)
Goto Top
Okey.
Diese Formel wird im Thread weiter oben abgehandelt! face-smile
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! face-smile
Mitglied: 76109
76109 Aug 10, 2010 at 20:52:43 (UTC)
Goto Top
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 werdenface-wink

Gruß Dieter
Member: xaumichi
xaumichi Aug 10, 2010 at 21:00:44 (UTC)
Goto Top
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
Mitglied: 76109
76109 Aug 10, 2010 at 21:18:39 (UTC)
Goto Top
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 Balkonface-wink

Gruß Dieter

[edit] Auf Anregung von xaumichi, die SVerweis-Formel nach Zeile 60 verschoben [/edit]
Member: xaumichi
xaumichi Aug 10, 2010 at 21:29:30 (UTC)
Goto Top
Naja, wär doch schade! face-wink

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!!! face-big-smile

Lg Mike
Mitglied: 76109
76109 Aug 10, 2010 at 21:48:11 (UTC)
Goto Top
Hallo Mike!

Zitat von @xaumichi:
Naja, wär doch schade! face-wink
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 malface-smile
Freut mich aber, dass Du dieses Problem von selbst lösen konntestface-wink

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.
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments