Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tabellenblatt automatisch beschriften

Betrifft: Tabellenblatt automatisch beschriften von: oblivion
Geschrieben am: 15.08.2008 19:20:31

Hallo, ich habe eine Frage. Gibt es eine Möglichkeit das Tabellenblatt automisch beschriften zu lassen, wenn man sagen wir in E4 einen Namen oder was anderes schreibt? Danke schon mal für eure Hilfe. Gruß Oblivion

  

Betrifft: AW: Tabellenblatt automatisch beschriften von: Hajo_Zi
Geschrieben am: 15.08.2008 19:25:22

Hallo ,

benutze das Chabge Ereignis, oder die Suche des Forums.

GrußformelHomepage


  

Betrifft: AW: Tabellenblatt automatisch beschriften von: Hajo_Zi
Geschrieben am: 15.08.2008 19:27:02

Hallo

da ist ein b anstelle von n es sollte Change lauten.

Gruß Hajo


  

Betrifft: Ja, das geht! von: Backowe
Geschrieben am: 15.08.2008 19:32:32

Hi,

VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Code in das entsprechende Tabellenblatt!
If Range("E4") <> "" Then ActiveSheet.Name = Target.Value
End Sub
Code eingefügt mit Syntaxhighlighter 4.15


Gruß Jürgen


  

Betrifft: Man könnte noch die Zelllänge abfragen, ... von: backowe
Geschrieben am: 15.08.2008 19:41:19

Hi,

... da der Tabellenblattname max. 31 Zeichen haben darf.

VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Code in das entsprechende Tabellenblatt!
If Len(Range("E4")) < 32 And Range("E4") <> "" Then
  ActiveSheet.Name = Range("E4").Value
End If
End Sub
Code eingefügt mit Syntaxhighlighter 4.15


Gruß Jürgen


  

Betrifft: Neue Frage zu Tabellenblättern von: oblivion
Geschrieben am: 15.08.2008 21:28:15

Halo, vielen Dank für die Hilfe. Ich habe aber gleich noch eine Frage. Ich habe eine Exceldatei mit mehreren Tabellenblättern. Auf einem Tabellenblatt trage ich monatlich gewisse Daten ein. Die Daten werden automatisch auf die anderen Tabellenblätter übertragen. Die Daten sind bestimmten Personen zugeordnet. Wenn ich jetzt eine neue Person habe die ich erfassen möchte, muss ich zur Zeit noch von Hand ein neues Tabellenblatt erstellen und es in die entsprechende Form bringen. Kann ich mit Hilfe eines VBAs dies auch automatisch machen lassen. Also wenn ich auf dem ersten Blatt einen neuen Namen schreibe, dass er mir dann ein neues Tabellenblatt erstellt mit einer vorher festgelegten Form?

Danke für die Hilfe.
Gruß Oblivion


  

Betrifft: Lege dir ein Tabellenblatt als Vorlage an ... von: backowe
Geschrieben am: 16.08.2008 00:36:25

Hi,



... und kopiere den folgenden Code hinein, tritt in E4 eine Änderung ein, wird von der Vorlage eine Kopie erstellt und nach rechts ans Ende gestellt und nach E4 benannt.

VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Code in das entsprechende Tabellenblatt!
If Len(Range("E4")) < 32 And Range("E4") <> "" Then
  If Sheets(Sheets.Count).Name <> Range("E4").Value Then
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Range("E4")
  End If
End If
End Sub

Code eingefügt mit Syntaxhighlighter 4.15


Gruß Jürgen


  

Betrifft: AW: Tabellenblatt automatisch anlegen von: Erich G.
Geschrieben am: 16.08.2008 07:53:46

Hi Jürgen,
Vorsicht - dein Code tut mehr als du beschrieben hast.

Er wird mit der Mustertabelle kopiert, steht dann x-fach in der Mappe läuft auch in jeder Kopie.

Er rennt nicht nur dann los, wenn sich in E4 etwas ändert, sondern bei Änderung jeder Zelle.

Wenn in E4 der Neme eines nichtletzten Blatts geschrieben wird, greift die Prüfung
If Sheets(Sheets.Count).Name <> Range("E4").Value Then
nicht und es gibt einen Laufzeitfehler.
In E4 kann eine Zahl stehen. Das gibt dann auch Ärger.

Mein Vorschlag:

                                 'Code in "DieseArbeitsmappe"
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim lngI As Long

   If Sh.Name <> "Muster" Then Exit Sub
   If Target.Address <> "$E$4" Then Exit Sub

   If Len(Target) < 32 And Target <> "" Then
      For lngI = 1 To Sheets.Count
         If Sheets(lngI).Name = "" & Target Then
            MsgBox "Das Blatt " & Target & " gibt es schon!"
            Exit Sub
         End If
      Next lngI
      Sheets("Muster").Copy After:=Sheets(lngI - 1)
      ActiveSheet.Name = Target
   End If
End Sub

Hier könnte/sollte/müsste man noch prüfen, ob E4.Value ein gültiger Blattname ist.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: Warum ich heute Nachte Sheets("Vorlage") ... von: Backowe
Geschrieben am: 16.08.2008 09:43:15

Hi Erich,

... durch Activesheet ersetzt habe, entzieht sich meiner Kenntnis. ;)

Gruß Jürgen


  

Betrifft: Noch eine Frage zu Tabellenblättern von: oblivion
Geschrieben am: 17.08.2008 15:53:43

Hallo @ Erich. Ich habe deinen Code gerade ausprobiert. Scheint alles so zu klappen. Aber ich habe noch eine Frage zu deinem Code. Ich habe eine Excel-Datei. Ich werde sie mal hochladen.
Nun zu meiner Frage. In diese Excel-Datei habe ich auf Blatt "Gesamt" in der Spalte ab L2 verschiedene Ärzte aufgelistet. Als ich die Orginaldatei erstellt hatte, habe ich schon 10 Ärzte gehabt. Kann man deinen Code so anpassen, dass er statt die Zelle E4 im Blatt Muster (eigentlich D7) nutzt, sondern immer wenn ich im Blatt "Gesamt" in Zeile L einen neuen Arzt reinschreibe mir dann ein neues Tabellenblatt mit dem entsprechenden Namen schreibt und gleichzeitig den Namen in die Zeile D7 setzt? Danke für deine Hilfe.
Gruß Oblivion


  

Betrifft: AW: Noch eine Frage zu Tabellenblättern von: oblivion
Geschrieben am: 17.08.2008 15:56:27

Hab Datei vergessen hochzuladen. Hier ist sie:

https://www.herber.de/bbs/user/54670.zip

Gruß Oblivion


  

Betrifft: AW: Noch eine Frage zu Tabellenblättern von: oblivion
Geschrieben am: 17.08.2008 17:11:47

Frage noch offen

Gruß Oblivion


  

Betrifft: AW: Tabellenblätter anlegen von: Erich G.
Geschrieben am: 17.08.2008 20:38:34

Hallo Oblivion,
da das Ereignis "neuer Arzt" jetzt in "Gesamt" auftritt, habe ich die Prozeduren "Workbook_SheetChange"
in Blatt "Muster" (da gehörte sie eh nicht hin) und in "DieseArbeitsmappe" gelöscht.

In "Worksheet_Change" von "Gesamt" habe ich ein "ArztAnlegen" eingebaut. Ich hoffe, dass es so funzt.

Auf den ersten Blick nicht verstanden habe ich, wofür in dieser Prozedur Selection.Count abgefragt wird.
Ist das sinnvoll? Ich habe eine Zeile davor mal eine neue Zeile mit der Anweisung
MsgBox Selection.Address
eingefügt. Da siehst du, was Selection gerade ist.

Die Zeilen mit EnableEvents = True und ScreenUpdating = True habe ich ich ein "AnzeigeAn" ausgelagert -
ich bin prinzipiell faul und versuche, Code nur einmal hinzuschreiben.

Und hier die Mappe: https://www.herber.de/bbs/user/54684.xls

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Tabellenblätter anlegen von: oblivion
Geschrieben am: 17.08.2008 21:18:43

hi, ich glaube es funktioniert so wie ich das mir vorgestellt habe. ich werde es noch in einem langzeit test ausführlich unter die lupe nehmen aber auf den ersten blick klappt alles. Was das selection macht, weiß ich auch nicht so genau. hab den code nicht selber geschrieben. hab ihn von einem anderen user aus diesem Forum bekommen. Danke nochmal für deine Hilfe.
Gruß oblivion


  

Betrifft: AW: Tabellenblätter anlegen von: Tino
Geschrieben am: 20.08.2008 17:54:43

Hallo,
bin grade mal dabei die Beiträge durchzulesen.

Das Selection.Count wird benötigt, da es vorkommen kann dass nicht nur eine Zelle bearbeitet wird
sondern z. Bsp. durch ziehen mehrere Daten auf einmal eigetragen werden, dann kommt man mit Target allein nicht weit.


Gruß Tino


  

Betrifft: AW: @Tino von: Erich G.
Geschrieben am: 20.08.2008 19:20:54

Hi Tino,
anstelle von Selection.Count könnte man besser Target.Count prüfen, muss man aber gar nicht.
Die Verarbeitung von ein- und die von mehrzelligen Änderungen braucht man nicht getrennt zu programmieren.

Nebenbei: Wenn für C=1 das zutrifft:
Intersect(Selection(C), Range("E5:G56", "B5:B56")) Is Nothing Then Exit Sub
dann wird der Rest der Selection überhaupt nicht mehr geprüft.

IMHO kann man den bisherigen Codeteil austauschen durch einen erheblich kürzeren.
(Oben muss dafür noch "rngZ As Range" deklariert werden.):

' bisher:
   On Error GoTo Fehler:
      MsgBox Selection.Address
   If Selection.Count > 1 Then
      For C = 1 To Selection.Count
         If Intersect(Selection(C), Range("E5:G56", "B5:B56")) Is Nothing Then _
            Exit Sub
         AnzeigeAn
         B = Tabelle2.Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Column - 2

         For A = 0 To 5
            If A <> 3 Then
               If A = 5 Then
                  Tabelle2.Cells(Selection(C).Row - 1, B - 1) = _
                     Cells(Selection(C).Row, 2).Value
               Else
                  Tabelle2.Cells(Selection(C).Row - 1, B + A).Value = _
                     Cells(Selection(C).Row, 3 + A).Value
               End If
            End If
         Next A
      Next C
   Else
      If Intersect(Target, Range("E5:G56", "B5:B56")) Is Nothing Then Exit Sub
      AnzeigeAn
      B = Tabelle2.Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
         LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
         MatchCase:=False, SearchFormat:=False).Column - 2

      For A = 0 To 5
         If A <> 3 Then
            If A = 5 Then
               Tabelle2.Cells(Target.Row - 1, B - 1) = Cells(Target.Row, 2).Value
            Else
               Debug.Print Cells(Target.Row, 3 + A)
               Tabelle2.Cells(Target.Row - 1, B + A).Value = _
                  Cells(Target.Row, 3 + A).Value
            End If
         End If
      Next A
   End If
Fehler:
'
'
' neu:
   On Error GoTo Fehler:
   If Intersect(Target, Range("E5:G56", "B5:B56")) Is Nothing Then Exit Sub
   B = Tabelle2.Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Column - 2
   AnzeigeAn
   For Each rngZ In Intersect(Target, Range("E5:G56", "B5:B56"))
      For A = 0 To 5
         If A <> 3 Then
            If A = 5 Then
               Tabelle2.Cells(rngZ.Row - 1, B - 1) = Cells(rngZ.Row, 2).Value
            Else
               Debug.Print Cells(rngZ.Row, 3 + A)
               Tabelle2.Cells(rngZ.Row - 1, B + A).Value = _
                  Cells(rngZ.Row, 3 + A).Value
            End If
         End If
      Next A
   Next rngZ
Fehler:

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: @Tino von: Tino
Geschrieben am: 20.08.2008 20:07:05

Hallo,
hast recht. super

Gruß Tino


 

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblatt automatisch beschriften"