Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1316to1320
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblatt finden - Code Error

Tabellenblatt finden - Code Error
19.06.2013 15:32:40
Martin
hallo!
ich bitte euch wieder um hilfe. ich habe mir meinen code zerstoert, und finde den fehler in der schleife nicht mehr.
er sollte checken, ob das blatt mit dem namen strBlatt vorhanden ist. wenn ja, sollte er es loeschen. in einem naechsten schritt, fuegt er ein blatt mit diesem namen wieder ein.
das ganze ist in einem laengeren sub inkludiert, habs nur jetzt als eigenes sub herausgenommen.
wenn jedoch kein blatt mit diesem namen existiert, dann erstellt er es und setz es an die richtige position.
vielen dank im voraus fuer eure hilfe!
gruesse,
martin

Sub Arbeitsblatt()
Dim wsBlatt As Worksheet
Dim strBlatt As String
Dim a As Boolean
a = False
strBlatt = "Sector ID " & strSectorID
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wsBlatt In ThisWorkbook.Worksheets
If strBlatt = wsBlatt.Name Then a = True
If a = True Then
Sheets(strBlatt).Select
ActiveWindow.SelectedSheets.Delete
Else
'End If
Set NewSheet = Worksheets.Add
NewSheet.Name = strBlatt
ActiveSheet.Move After:=Sheets("SPOC-Contingency Task")
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
/pre>

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblatt finden - Code Error
19.06.2013 15:41:57
Klaus
Hi,
das
strBlatt = "Sector ID " & strSectorID
kann nichts ergeben, da die Variable strSectorID nicht gefüllt ist. Ich nehme an, die wird woanders gefüllt - du schreibst ja es ist nur ein Ausschnitt. Aber zum Testen ist das halt schwierig.
Unter der Annahme, dass strBlatt einen gültigen Blattnamen ergibt, hätte ich es so gelöst:
Sub Arbeitsblatt()
Dim strBlatt As String
strBlatt = "Sector ID " & strSectorID
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If WksSheetExists(strBlatt) Then Sheets(strBlatt).Delete
Sheets.Add
With ActiveSheet
.Name = strBlatt
.Move After:=Sheets("SPOC-Contingency Task")
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function WksSheetExists(sSheet As String) As Boolean
Dim wks As Object
On Error Resume Next
Set wks = Sheets(sSheet)
If Not wks Is Nothing Then
WksSheetExists = True
End If
On Error GoTo 0
End Function
Grüße,
Klaus M.vdT.

Anzeige
AW: Tabellenblatt finden - Code Error
19.06.2013 15:43:50
JACKD
Hallo Martin
Zuerst mal ist deine Schleife irgendwie seltsam
brauchst du das "a" im weiteren?
denn sonst brauchst ihn ni
Verkürzt würde ich es so abbilden
Ach, und in dem abgebildetetn Code von dir fehlt die variable strSectorID die ist also leer =)
Ich vermute jedoch das es das auskommentierte
End if und das fehlende next
Sub Arbeitsblatt()
Dim wsBlatt As Worksheet
Dim strBlatt As String
strBlatt = "Sector ID " & strSectorID
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wsBlatt In ThisWorkbook.Worksheets
If strBlatt = wsBlatt.Name Then
Sheets(strBlatt).Delete
Set NewSheet = Worksheets.Add
NewSheet.Name = strBlatt
ActiveSheet.Move After:=Sheets("SPOC-Contingency Task")
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Anzeige
Ich bin nicht sicher, aber ...
19.06.2013 15:45:30
Klaus
... wenn du innerhalb einer "For each Worksheet"-Schleife ein neues Worksheet erstellst und verschiebst, riskiert das nicht eine Endlosschleife?
Grüße,
Klaus M.vdT.

Ich auch nicht
19.06.2013 15:51:55
JACKD
hab das auch nur so lapidar dahin geschrieben. =)
Aber grad mal ausprobiert, und es funktioniert..
Ich weiss halt nicht, ob excel das for each bei jedem mal neu bestimmt, oder ob er beim ersten durchlauf alle Blätter bestimmt.
In einer endlosschleife endet es jedenfalls nicht =)
Grüße

AW: Tabellenblatt finden - Code Error
19.06.2013 15:48:50
UweD
Hallo
- ungeprüft. aber so müsste es gehen.
- strSectorID hat so keinen Inhalt
- a braucht du so nicht

Sub Arbeitsblatt()
On Error GoTo Fehler
Dim wsBlatt As Worksheet
Dim NewSheet As Worksheet
Dim strBlatt As String
Dim a As Boolean
Dim strSectorID ' ***Fehlt
'strSectorID= ?
strBlatt = "Sector ID " & strSectorID
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wsBlatt In ThisWorkbook.Worksheets
If strBlatt = wsBlatt.Name Then
Sheets(strBlatt).Delete
Set NewSheet = Worksheets.Add
NewSheet.Name = strBlatt
ActiveSheet.Move After:=Sheets("SPOC-Contingency Task")
End If
Next
Fehler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Gruß UweD

Anzeige
Code einfacher
19.06.2013 15:51:54
Erich
Hi Martin,
wenn schon erst gelöscht und dann wieder angelegt werden soll:

Option Explicit        ' immer zu empfehlen
Sub Arbeitsblatt()
Dim wsBlatt As Worksheet, strBlatt As String
Dim strSectorID As String                 ' Dekl. fehlte
strSectorID = "xyz"
strBlatt = "Sector ID " & strSectorID
'   Application.ScreenUpdating = False  ' nach dem Test evtl. aktivieren
For Each wsBlatt In ThisWorkbook.Worksheets
If UCase$(wsBlatt.Name) = UCase$(strBlatt) Then
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Next wsBlatt
Worksheets.Add After:=Sheets("SPOC-Contingency Task")
ActiveSheet.Name = strBlatt
'   Application.ScreenUpdating = True ' falls nötig
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
und noch einfacher
19.06.2013 16:01:22
Erich
Hi,
statt
For Each wsBlatt In ThisWorkbook.Worksheets
reicht
For Each wsBlatt In Worksheets
Wäre die Mappe anzugeben, dann IMMER, also auch bei
Sheets(strBlatt)
Worksheets.Add
....Move After:=Sheets("...")
Noch eine Bemerkung: Ich habe am Beginn meines vorigen Posts zwei pre-Ende-Tags eingefügt,
damit der Thread aus dem "pre-Mode" rauskommt. Sieht man im Archivthread ganz deutlich. :-)
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

und noch: AW: und noch einfacher
19.06.2013 16:03:23
Klaus
Hallo Erich,
wenn wir schon am vereinfachen sind,
wozu überhaupt die Schleife über die Worksheets? Vgl. meine schleifenfreie Lösung weiter oben.
Grüße,
Klaus M.vdT.

Anzeige
und noch mal einfacher
19.06.2013 16:15:39
Erich
Hi Klaus,
klar, da hast du natürlich recht - mit ohne Schleife geht das einfacher und kürzer.
Eine Kurzvariante:
https://www.herber.de/forum/archiv/1088to1092/1088944_Ueberpruefen_ob_Tabellenblatt_existiert.html#1088951
In meinem Code stand noch mehr Müll - "ActiveWindow.SelectedSheets.Delete" :-(
Hier also eine neue Version:

Option Explicit            ' immer zu empfehlen
Sub Arbeitsblatt()
Dim wsBlatt As Worksheet, strBlatt As String
Dim strSectorID As String                 ' Dekl. fehlte
strSectorID = "xyz"
strBlatt = "Sector ID " & strSectorID
'   Application.ScreenUpdating = False  ' nach dem Test evtl. aktivieren
If SheetEx(strBlatt) Then
Application.DisplayAlerts = False
Sheets(strBlatt).Delete
Application.DisplayAlerts = True
End If
Worksheets.Add After:=Sheets("SPOC-Contingency Task")
ActiveSheet.Name = strBlatt
'   Application.ScreenUpdating = True ' falls nötig
End Sub
Function SheetEx(strNam As String) As Boolean
On Error Resume Next
SheetEx = Sheets(strNam).Index > 0
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Rueckmeldung an alle
19.06.2013 17:06:31
Martin
hallo ihr lieben helfer!
vielen dank, dass ihr mir so rasch helfen konntet. ich habe letztlich den code von erich g. genommen, musste nur von thisWorkbook auf activWorkbook aendern, und das loeschen anpassen. unter 'Tabellenblatt ist er nun zu finden. nun funktioniert alles wie es sol! vielen herzlichen dank nochmals!
ich habe mein gesamtes sub nochmals angefuegt.
eine frage zu dem sub habe ich noch, wie kann ich leere worksheets loeschen? mit der specialCells methode bin ich nicht weit gekommen, da die zu durchsuchenden sheets zu gross sind (da haengt sich das system auf!)
vielen dank nochmals an alle,
liebe gruesse,
martin
Sub SectorID()
Dim strSectorID As String, OK As Boolean, i As Integer
Dim lngStartZeile As Long, lngEndeZeile As Long
Dim iSpalte As Integer
Dim ws As Worksheet
Dim idAbfrage As String
Dim c As Range
Dim wsBlatt As Worksheet
Dim strBlatt As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'Sector ID eingeben
OK = True
strSectorID = Application.InputBox("Please enter the required Sector ID: ", "Sector ID  _
Search", , , , , , 1)
For i = 1 To Len(strSectorID)
If Mid(strSectorID, i, 1)  "9" Then
OK = False
Exit For
End If
Next
If strSectorID = "" Or OK = False Then
MsgBox "Wrong input - Only positive numbers are accepted!"
Exit Sub
End If
'Abfrage ob Sector ID existiert
Set ws = Sheets("SPOC-Contingency Task")
Set c = ws.Range("A:A").Find(strSectorID, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Else
MsgBox "This Sector ID doesn't exist!"
Exit Sub
End If
'Tabellenblatt
strBlatt = "Sector ID " & strSectorID
For Each wsBlatt In ActiveWorkbook.Worksheets
If UCase$(wsBlatt.Name) = UCase$(strBlatt) Then
Application.DisplayAlerts = False
Sheets(strBlatt).Activate
ActiveSheet.Delete
'ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Next wsBlatt
Worksheets.Add After:=Sheets("SPOC-Contingency Task")
ActiveSheet.Name = strBlatt
'ZeilenKopieren
Sheets(strBlatt).Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("SPOC-Contingency Task").Select
ActiveSheet.Range("$a$1:$h$65536").AutoFilter Field:=1, Criteria1:=strSectorID, _
Operator:=xlAnd
For lngStartZeile = 2 To Cells.SpecialCells(xlCellTypeLastCell).row
If Rows(lngStartZeile).Hidden = False Then
Cells(lngStartZeile, 2).Select
Exit For
End If
Next
lngEndeZeile = Cells(Rows.Count, (1)).End(xlUp).row
lngEndeZeile = Cells(Rows.Count, "A").End(xlUp).row
Range(Rows(lngStartZeile), Rows(lngEndeZeile)).Select
Worksheets("SPOC-Contingency Task").Range("A1").CurrentRegion.SpecialCells( _
xlCellTypeVisible).Copy Worksheets(strBlatt).Range("A1")
'Spaltenbreite kopieren:
For iSpalte = 1 To ActiveSheet.UsedRange.columns.Count
Worksheets(strBlatt).columns(iSpalte).ColumnWidth = Worksheets("SPOC-Contingency  _
Task").columns(iSpalte). _
ColumnWidth
Next iSpalte
'Sortierungsfilter deselektieren
Sheets("SPOC-Contingency Task").Select
Range("A1").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Sheets(strBlatt).Select
Range("A1").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Application.ScreenUpdating = True
ErrorHandler:
On Error GoTo 0
End Sub
/pre>

Anzeige
Danke für deine Rueckmeldung und ...
20.06.2013 07:09:00
Erich
Hi Martin,
...noch zwei Codevorschläge (einer zum Löschen der leeren Blätter):

Option Explicit
Sub SectorID2()
Dim strSectorID As String, ii As Integer
Dim rngC As Range
Dim strBlatt As String
'                                   ' notwendig?
'   On Error GoTo ErrorHandler      ' NACH Test evtl. aktivieren
'Sector ID eingeben
strSectorID = CStr(Application.InputBox("Please enter the" & _
"required Sector ID: ", "Sector ID Search ", , , , , , 1))
If strSectorID = "" Or LCase(strSectorID) = "false" _
Or LCase(strSectorID) = "falsch" Then
MsgBox "Wrong input - empty!"
Exit Sub
End If
For ii = 1 To Len(strSectorID)
If Mid(strSectorID, ii, 1)  "9" Then
MsgBox "Wrong input - Only positive numbers are accepted!"
Exit Sub
End If
Next ii
With Sheets("SPOC-Contingency Task")
'Abfrage ob Sector ID existiert (ZÄHLENWENN)
If Application.CountIf(.Columns(1), strSectorID) = 0 Then
MsgBox "The Sector ID '" & strSectorID & "' doesn't exist!"
Else
'        Application.ScreenUpdating = False ' NACH Test evtl. aktivieren
'Tabellenblatt
strBlatt = "Sector ID " & strSectorID
If SheetEx(strBlatt) Then
Application.DisplayAlerts = False
Sheets(strBlatt).Delete
Application.DisplayAlerts = True
End If
Worksheets.Add After:=Sheets("SPOC-Contingency Task")
ActiveSheet.Name = strBlatt
'ZeilenKopieren
.Range("A1").CurrentRegion.AutoFilter Field:=1, _
Criteria1:=strSectorID
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(strBlatt).Cells(1, 1)
'Spaltenbreite kopieren:
For Each rngC In .UsedRange.Columns
Worksheets(strBlatt).Columns(rngC.Column).ColumnWidth = _
rngC.ColumnWidth
Next rngC
'Sortierungsfilter deselektieren
.AutoFilterMode = False
Sheets(strBlatt).Range("$A$1:$H$65536").AutoFilter Field:=1  ' wozu ?
End If
End With
ErrorHandler:
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Function SheetEx(strNam As String) As Boolean
On Error Resume Next
SheetEx = Sheets(strNam).Index > 0
End Function
Sub LeereBlaetterLoeschen()
Dim wks As Worksheet
Application.DisplayAlerts = False
For Each wks In ActiveWorkbook.Worksheets
If Sheets.Count = 1 Then Exit For         ' 1 Blatt muss bleiben
If Application.CountA(wks.Cells) = 0 Then wks.Delete
Next wks
Application.DisplayAlerts = True
End Sub
Noch eine Bemerkung:
Wenn du in deinem Beitrag Code einfügst, dann zwischen zwei pre-Tags. Das ist gut so.
Aber irgendwie geht dir beim abschließenden /pre das "<" vor dem /pre verloren.
Im Archiv wird dann alles Nachfolgende falsch dargestellt.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Quick'n'dirty
19.06.2013 16:49:48
Rudi
Hallo,
wenn man schon On Error nutzt, um die Existenz zu bestimmen, kann man es auch nutzen, um ein nicht existentes Blatt zu löschen. ;-)
Sub Arbeitsblatt()
Dim strBlatt As String
strBlatt = "Sector ID " '& strSectorID
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets(strBlatt).Delete
On Error GoTo 0
Worksheets.Add.Name = strBlatt
ActiveSheet.Move After:=Sheets("SPOC-Contingency Task")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Gruß
Rudi

Anzeige
AW: Quick'n'dirty
19.06.2013 17:09:09
Jack
Die Ist jetzt mal wirklich Dirty ;-)
Find ich gut ;-)

AW: Quick'n'dirty
19.06.2013 20:52:24
Klaus
*applaus*
das ist so falsch, dass es schön ist!
Grüße,
Klaus M.vdT.

Quick'n'dirty 2
20.06.2013 06:45:09
Erich
Hi Rudi,
dazu mache ich mal diesen Vorschlag:

Sub Arbeitsblatt2()
Dim strBlatt As String
strBlatt = "Sector ID " '& strSectorID
Application.ScreenUpdating = False
' lösche evtl. altes Blatt
Application.DisplayAlerts = False
On Error Resume Next
Sheets(strBlatt).Delete
On Error GoTo 0
Application.DisplayAlerts = True
' lege neues Blatt an
Worksheets.Add(After:=Sheets("SPOC-Contingency Task")).Name = strBlatt
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige