Hallo Zusammen, ich benötige eure Hilfe.
Den VBA-Code haben einige VBA Spezialisten von Euch in der Vergangenheit erstellt. Nun benötige ich eine Anpassung. Leider kenne ich mich noch nicht so gut mit der VBA Programmierung aus um den Code selbst anzupassen. Es geht um folgendes:
Istzustand:
In Zelle A9:A38 werden Nummern im Format xxx.xx (z.B. 244.01) eingeben und dadurch ein Tabellenblatt kopiert. Beim Löschen der Eingabe, wird auch das Tabellenblatt wieder gelöscht.
Sollzustand:
Nun soll in den Zellen A9:A38 ein Buchstaben und Zahlen Kombination eingegeben werden z.B. L001 Ein Tabellenblatt wird auch kopiert, jedoch wird beim Löschen der Eingabe, dass Tabellenblatt nicht wieder gelöscht. Hier müsste der Code angepasst werden. Kann mir jemand dabei helfen und den Code anpassen ?
Ich danke Euch schon im Voraus für die Hilfe.
Link Datei
http://www.file-upload.net/download-9129596/2014-06-…
Gruss Marco
Sorry, hier nochmal der Link zur Datei ohne Passwort:
http://www.file-upload.net/download-9129674/2014-06-…
Danke
Gruss Marco
Hallo Marco,
ich habe den Code in deiner Mappe mal laufen lassen. Bist du sicher, dass er nicht schon das macht, was du willst? Da deine neuen Eingaben nicht mehr numerisch sind (L001 ist keine Zahl) sollte der Code auch nichts mehr löschen.
Es sei denn, ich habe den Code auf die Schnelle nicht genau durchschaut (abe so kompliziert ist er ja nicht).
Hast du es mal versucht? Probier’s mal und gib eine Rückmeldung.
Gruß, Andreas
Hallo Andreas,
danke für deine Antwort. Der Code funktioniert bis auf das löschen. Ich möchte das beim löschen der Eingabe auch das Tabellenblatt gelöscht wird, so wie es bei der nummerischen Eingabe gemacht wird.
Gruss Marco
danke für deine Antwort. Der Code funktioniert bis auf das
löschen. Ich möchte das beim löschen der Eingabe auch das
Tabellenblatt gelöscht wird, so wie es bei der nummerischen
Eingabe gemacht wird.
Hallo Marco,
so vllt.:
Sub Loesche()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets("Anlagen Total")
For Each wks In Worksheets
If wks.Name "Anlagen Total" And wks.Name "Basis" Then
If Application.CountIf(.Range("A9:A38"), wks.Name) = 0 Then wks.Delete
End If
Next wks
End With
Application.DisplayAlerts = True
End Sub
Gruß
Reinhard
Danke Reinhard,
das Tabellenblatt wird nun erstellt und auch wieder gelöscht. Das Problem was nun besteht, und was Du nicht wissen konntest, ist, dass ich noch mehrere Tabellenblätter in der Datei habe. Diese werden nun beim erstellen bis auf die Tabellenblätter „Anlagen Total“, „Basis“ komplett gelöscht. Ich habe eine neue Datei hochgeladen mit der Anordnung der weiteren Tabellenblätter. Diese dürfen nicht gelöscht werden, da diese für Berechnung verwendet werden. Kurz gesagt, die Tabellenblätter die ich über die Eingabe in den Zellen erstelle, sollen bei löschen des Zellinhaltes auch nur gelöscht werden.
Kann man das einbauen ?
http://www.file-upload.net/download-9134812/2014-06-…
Gruss Marco
Habe den Code angepasst, ist bestimmt nicht die eleganteste Art, aber der Code funktioniert.
Sub Loesche()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets(„Anlagen Total“)
For Each wks In Worksheets
If wks.Name „Anlagen Total“ _
And wks.Name „Basis“ _
And wks.Name „Allg. Daten“ _
And wks.Name „Grundlagen“ _
And wks.Name „Datentabelle“ _
And wks.Name „Auslegung“ _
And wks.Name „Berechnung“ _
And wks.Name „Daten 1“ _
And wks.Name „Daten 2“ _
And wks.Name „Daten 3“ _
And wks.Name „Pulldowns“ _
And wks.Name „Schacht“ _
And wks.Name „Schema“ _
And wks.Name „SD1“ _
And wks.Name „SD“ Then
If Application.CountIf(.Range(„A9:A38“), wks.Name) = 0 Then wks.Delete
End If
Next wks
End With
Application.DisplayAlerts = True
End Sub
Gruss Marco
Hallo Marco,
in deinem Ursprungsposting klang es so, als ob die Blätter die gelöscht werden dürfen/müssen alle das gleiche Namensschema haben: L und dann eine Anzahl von Ziffern.
Falls das so ist, hätte ich hier noch eine Variante der Löschroutine:
Sub Loesche()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets("Anlagen Total")
For Each wks In Worksheets
If sollGeloeschtWerden(wks.Name) And Application.CountIf(.Range("A9:A38"), wks.Name) = 0 Then wks.Delete
Next wks
End With
Application.DisplayAlerts = True
End Sub
Function sollGeloeschtWerden(blatt As String)
Dim p As Long
sollGeloeschtWerden = (Left(blatt, 1) = "L")
For p = 2 To Len(blatt)
sollGeloeschtWerden = sollGeloeschtWerden And (Mid(blatt, p) \>= "0" And Mid(blatt, p)
Gruß, Andreas
Hallo Marco,
was ich die ganze Zeit schon fragen wollte, was issen mit der Prozedur „Formel“? Da wird nur der Inhalt von zwei Spalten gelöscht. Ist da was zu tun?
Zur Eleganz, m.E, wäre es am elegantesten den Blättern die nie gelöscht werden dürfen entsprechende Codenamen zu verpassen.Jedes Blatt hat einen Codenamen und einen Namen.
(Im VB-Editor siehste links die Codenamen und die Namen der Blätter, die Namen sind die in Klammern. Die Namen siehste auch in Excel.)
Laut Excel-Hilfe sind die Codenamen für Vba schreibgeschützt, also nicht per Code änderbar. Manuell kannste die Codenamen ändern, im Editor das Tabellenblatt anklicken, dann F4.
Wären jetzt die zu schützenden Blätter alle derart umbenannt worden in Marco01 bis Marco15 so sähe die Prozedur „Loesch“ so aus:
Sub Loesche()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets("Anlagen Total")
For Each wks In Worksheets
If Application.CountIf(.Range("A9:A38"), wks.Name) = 0 And Not wks.CodeName Like "Marco\*" Then wks.Delete
Next wks
End With
Application.DisplayAlerts = True
End Sub
WEnn du magst kannste das ja mal in einer Mappenkopie testen. Ich habe versucht, trotz der Aussage in der Hilfe, dies mit Vba zu „erledigen“, der Code:
Sub Einmalig()
Dim W As Integer
For W = 1 To Worksheets.Count
With Worksheets(W)
'ThisWorkbook.VBProject.VBComponents("Tabelle" & W).Properties(5).Value = "Marco" & Format(W, "00")
'ThisWorkbook.VBProject.VBComponents(.CodeName).Name = "Marco" & Format(W, "00")
End With
Next W
End Sub
Beide relevanten Codezeilen funktionieren aber es geschehen seltsame Dinge. Manuell eingefügte Blätter heißen auf einmal auch „MarcoXX“ !??
Aber an meinen Testdateien testete ich diversen Code, kann sein daß es da Nebeneffekte gab. Morgen ist auch noch ein Tag, schauen wir mal 
Gruß
Reinhard
Hallo Reinhard,
bin neugierig: Wo hast du die „Properties(5)“ her? In der VBA Hilfe (bei Excel 2010 eigentlich eher ein Witz) habe ich nix richtiges gefunden.
Gruß, Andreas
bin neugierig: Wo hast du die „Properties(5)“ her? In der VBA
Hilfe (bei Excel 2010 eigentlich eher ein Witz) habe ich nix
richtiges gefunden.
Hallo Andreas,
die Codezeile stand so in einer Beitragsfolge aus dem I-Net gefischt. Sonst stand da nix wesentliches dabei. Naja, der Anfrager bekam eine Fehlermeldung aber das lag an dem fehlenden Häkchen in Makro-Sicherheit bei „dem Vba-Projekt vertrauen“ oder wie das heißt.
Also bringt dir die Beitragsfolge nix aber vllt. etwas andreas wenn du den Kniff nich kennst.
Nimm mal diesen Code in der Mappe von Marco:
Sub tt()
Dim S
Set S = ThisWorkbook.VBProject.VBComponents
End Sub
und gehe ihn mit F8 ab bis „End Sub“ markiert ist. Dann Ansicht—Lokalfenster. Klick dann auf „S“, such dir ein Item aus und klicke es an, dort dann auf Properties…
Dann weißte soviel wie ich.
Guts Nächtle
Reinhard
Morsche, Reinhard,
dein Tipp sieht mir ja nach 'ner echten Schatzkiste aus. Ich muss da mal genauer drin stöbern.
Vielen Dank und Gruß,
Andreas
Hallo Andreas,
dein Tipp sieht mir ja nach 'ner echten Schatzkiste aus.
da haste sehr wahr Ich hatte mich sehr gefreut als mir jmd. diesen Dreh verriet.
Ich muss da mal genauer drin stöbern.
Ja, mach das. Hilfreich beim Referenzieren.
Du bist ja schon Vbafit und würdeste mit Vba nach deinen blauen Socken suchen so hilft dir der Dreh um genau auf die richtige Referenzierung für die Suche zu kommen *gg*
With Milchstraße.Erde.Europa.Deutschland.Hamburg.Harburg.Waldstraße(139)
msgbox SucheIn(.Stock(2),Zimmer("Schlafzimmer").Schrank.Schublade(12)
Gruß
Reinhard
Vielen Dank für Eure Antworten,
werde die Codes mal testen und Euch berichten.
Vielen Dank
Gruss Marco
werde die Codes mal testen und Euch berichten.
Hallo Marco,
mit der Codename-Variante hab ich mich jetzt noch nicht weiter beschäftigt.
Nachfolgend sind noch zwei andere Varianten. Sie beruhen darauf daß entweder den zur Laufzeit erzeugten Blättern was an den „normalen“ Namen gehängt wird oder aber deinen Blättern die nie gelöscht werden dürfen von Vba.
Ich habe es angehängt und nicht vorangestellt denn dadurch „stört“ die Namensendung nicht so unten in der Blattregisteranzeige in Excel.
Ich versuche hier alle Änderungen zu fetten.
Gruß
Reinhard
Option Explicit
Sub ErstelleA(ByRef Target As Range)
Dim Zelle As Range
On Error GoTo home
For Each Zelle In Target
If Zelle.Value "" Then
If Not Vorhanden(Zelle.Value) = True Then
Worksheets("Basis").Visible = xlSheetVisible
Worksheets("Basis").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Zelle.Value **& "\_M"**
ActiveSheet.Range("A2").Value = Zelle.Value
Worksheets("Basis").Visible = xlSheetVeryHidden
End If
End If
Next Zelle
home:
If Err.Number 0 Then
**MsgBox "Fehler in Prozedur --Erstelle--" & vbLf & Err.Number & vbLf & Err.Description**
End If
Worksheets("Anlagen Total").Activate
End Sub
Sub LoescheA()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets("Anlagen Total")
For Each wks In Worksheets
If Application.CountIf(.Range("A9:A38"), wks.Name) = 0 **And wks.Name Like "\*\_M"** Then wks.Delete
Next wks
End With
Application.DisplayAlerts = True
End Sub
Sub ErstelleB(ByRef Target As Range)
Dim Zelle As Range
On Error GoTo home
For Each Zelle In Target
If Zelle.Value "" Then
If Not Vorhanden(Zelle.Value) = True Then
Worksheets("Basis").Visible = xlSheetVisible
Worksheets("Basis").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Zelle.Value
ActiveSheet.Range("A2").Value = Zelle.Value
Worksheets("Basis").Visible = xlSheetVeryHidden
End If
End If
Next Zelle
home:
If Err.Number 0 Then
**MsgBox "Fehler in Prozedur --Erstelle--" & vbLf & Err.Number & vbLf & Err.Description**
End If
Worksheets("Anlagen Total").Activate
End Sub
Sub LoescheB()
Dim wks As Worksheet
Application.DisplayAlerts = False
With Worksheets("Anlagen Total" **& "\_M"** )
For Each wks In Worksheets
If Application.CountIf(.Range("A9:A38"), wks.Name) = 0 And **Not wks.Name Like "\*\_M"** Then wks.Delete
Next wks
End With
Application.DisplayAlerts = True
End Sub
**Sub Einmalig()
Dim W As Integer
For W = 1 To Worksheets.Count
Worksheets(W).Name = Worksheets(W).Name & "\_M"
Next W
End Sub**