Prüfung bezüglich Worksheet

Hallo ihr Excelspezialisten,
ich suche seit einer Weile nach der Lösung meines Problems.
Ich habe eine umfangreiche Datei in der beim Start der Basisdatei neue Arbeitsblätter angelegt werden.
Das System läuft so, dass links von dem Arbeitsblatt "Eingabe lfd. Schuljahr" Arbeitsblätter eingefügt werden. Als erstes Blatt z.B. "Konto 2016" und rechts davon "Jahresabrechnung 2016". Beim Jahr kommt dann links von "Konto 2016" "Konto 2017" und rechts von "Jahresabrechnung 2016" "Jahresabrechnung 2017".
Dargestellt wie folgt:
Konto 2017 Konto 2016 Jahresabrechnung 2016 Jahresabrechnung 2017 Eing lfd. Schuljahr
Wenn das Konto 2016 und die Jahresabrechnung 2017 neu angelegt sind, kann ein bestimmter Eintrag in Jahresabrechnung 2016 erst dann eingefügt werden, wenn das Konto 2017 und Jahresabrechnung 2017 angelegt sind.
Bei der Neuanlage habe ich im Makro für das Einfügen folgende Prüfung:
If Worksheets("Eingabe lfd. Schuljahr").Index = 0 Then
MsgBox "Bitte zuerst weiteres Konto anlegen"
Exit Sub
Else
Worksheets(Worksheets("Eingabe lfd. Schuljahr").Index - 2).Select
end if
Wenn nun weitere Jahresabrechnungen vorhanden sind soll die jeweils nächste Prüfung erfolgen.
Ich hoffe ich habe mich verständlich ausgedrückt.
Ist das so überhaupt lösbar oder ist es besser über eine Abfrage in der Auflistung
in einer Tabelle?
Ich füge eine Musterdatei bei, die aber nur diesen Bereich betrifft.

Die Datei https://www.herber.de/bbs/user/110568.xlsm wurde aus Datenschutzgründen gelöscht

Besten Dank für Eure Hilfe.
Gruss
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub naechstesJahrAnlegen() Dim blatt As String, kBlatt As String, jBlatt As String, k0Blatt As String Dim jahr As Long, k0 As Long Dim sh As Worksheet Dim jOk As Boolean, kOk As Boolean blatt = ActiveSheet.Name If InStr(blatt, "Jahresabr") > 0 Then If Range("B5") = "neu" Then ' irgendeine Bedingung jahr = Right(blatt, 4) + 1 jBlatt = Left(blatt, Len(blatt) - 4) & jahr kBlatt = "Konto " & jahr k0Blatt = "Konto " & jahr - 1 For Each sh In Worksheets If sh.Name = jBlatt Then jOk = True If sh.Name = kBlatt Then kOk = True If sh.Name = k0Blatt Then k0 = sh.Index Next If k0 = 0 Then MsgBox "Konto " & jahr - 1 & " nicht vorh. - Abbruch" If Not jOk Then MsgBox jBlatt & " existiert nicht" Sheets.Add after:=ActiveSheet ActiveSheet.Name = jBlatt End If If Not kOk Then MsgBox kBlatt & " existiert nicht" Sheets.Add before:=Sheets(k0) ActiveSheet.Name = kBlatt End If If Not (kOk Or jOk) Then Sheets(blatt).Activate ' oder was auch immer End If End If End Sub

on error resume next Worksheets(Worksheets("Eingabe lfd. Schuljahr").Index - 2).Select if err.number0 then msgbox "geht nicht" Exit sub endif on error goto 0 ' und weiter im Programm, das richtige Blatt ist ja dann ' bereits selektiert

Sub Prüfung_Jahresabrechnung_vorhanden() Dim Vorjahr1 As String 'aus Worksheets("Vorschau und Drucken") Dim Vorjahr2 As String 'aus Worksheets("Anfang und Enddatum") Worksheets("Vorschau und Drucken").Activate 'markiert den erforderlichen Wert aus Tabelle "Anfang und Enddatum" Range R6 'Call Wert_ausZelle_R6_suchen_markieren Dim Liste As Range Dim Suchbegriff As String Dim Zelle As Range Suchbegriff = Worksheets("Anfang und Enddatum").Range("R6").Value 'Debug.Print Suchbegriff Set Liste = Range(Cells(2, 23), Cells(Cells(1, 1).CurrentRegion.Rows.Count, 23)) For Each Zelle In Liste ' If zelle.Value = "2017" Then If Zelle.Value = Suchbegriff Then ' zelle.Delete Shift:=xlToLeft Zelle.Select End If Next 'ab hier Prüfung Vorjahr Vorjahr1 = ActiveCell Vorjahr2 = Worksheets("Anfang und Enddatum").Range("R6").Value 'Debug.Print Vorjahr1 'Debug.Print Vorjahr2 If Worksheets("Vorschau und Drucken").Range("V2") = "" Then MsgBox "Es ist noch keine Tabelle vorhanden" Exit Sub Else If Vorjahr2 = ActiveCell Then MsgBox "beide Zellen sind identisch" ActiveCell.Offset(0, -1).Select 'ab hier erfolgt Prüfung, ob Tabelle existiert Dim sName As String sName = ActiveCell If SheetExists(sName) Then Application.DisplayAlerts = False Sheets(sName).Select Application.DisplayAlerts = True Else Worksheets.Add ActiveSheet.Name = sName End If 'MeinMakro ausführen: Modul1 - Jahresabrechnung_Übertrag_vorherigesSchuljahrKassenprüfung Call Jahresabrechnung_Übertrag_vorherigesSchuljahrKassenprüfung Else 'hier Abbruch, wenn noch keine zweite Jahresabrechnung besteht MsgBox "Es ist keine zweite Tabelle vorhanden" Exit Sub End If End If End Sub

Hallo Michael,
das mit der Auswahl der zutreffenden Seite war doch ein wenig aufwendiger. Es war nicht damit gedient,
nur das Worksheet auszuwählen.
Ich habe das ganze jetzt wie folgt gelöst:
Option Explicit
'wird von ttx_2 benötigt

Function SheetExists(sName As String) As Boolean
Dim sh
For Each sh In Sheets
If sh.Name = sName Then
SheetExists = True
Exit Function
End If
Next
End Function

Sub Prüfung_Jahresabrechnung_vorhanden()
Dim Vorjahr1 As String  'aus Worksheets("Vorschau und Drucken")
Dim Vorjahr2 As String  'aus Worksheets("Anfang und Enddatum")
Worksheets("Vorschau und Drucken").Activate
'markiert den erforderlichen Wert aus Tabelle "Anfang und Enddatum" Range R6
'Call Wert_ausZelle_R6_suchen_markieren
Dim Liste As Range
Dim Suchbegriff As String
Dim Zelle As Range
Suchbegriff = Worksheets("Anfang und Enddatum").Range("R6").Value
'Debug.Print Suchbegriff
Set Liste = Range(Cells(2, 23), Cells(Cells(1, 1).CurrentRegion.Rows.Count, 23))
For Each Zelle In Liste
'        If zelle.Value = "2017" Then
If Zelle.Value = Suchbegriff Then
'            zelle.Delete Shift:=xlToLeft
Zelle.Select
End If
Next
'ab hier Prüfung Vorjahr
Vorjahr1 = ActiveCell
Vorjahr2 = Worksheets("Anfang und Enddatum").Range("R6").Value
'Debug.Print Vorjahr1
'Debug.Print Vorjahr2
If Worksheets("Vorschau und Drucken").Range("V2") = "" Then
MsgBox "Es ist noch keine Tabelle vorhanden"
Exit Sub
Else
If Vorjahr2 = ActiveCell Then
MsgBox "beide Zellen sind identisch"
ActiveCell.Offset(0, -1).Select
'ab hier erfolgt Prüfung, ob Tabelle existiert
Dim sName As String
sName = ActiveCell
If SheetExists(sName) Then
Application.DisplayAlerts = False
Sheets(sName).Select
Application.DisplayAlerts = True
Else
Worksheets.Add
ActiveSheet.Name = sName
End If
'MeinMakro ausführen: Modul1 - Jahresabrechnung_Übertrag_vorherigesSchuljahrKassenprüfung
Call Jahresabrechnung_Übertrag_vorherigesSchuljahrKassenprüfung
Else
'hier Abbruch, wenn noch keine zweite Jahresabrechnung besteht
MsgBox "Es ist keine zweite Tabelle vorhanden"
Exit Sub
End If
End If
End Sub

Besten Dank noch für Deine Hilfe.
Gruss Peter

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread