Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1860to1864
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1860to1864
1860to1864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehler abfangen

Fehler abfangen
29.12.2021 13:47:14
Chris
Liebes Forum,
ich nutze unten stehendes Makro, um Werte aus einer Liste auf verschiedene Sheets aufzuteilen bzw. hineinzukopieren. Dies funktoniert soweit gut.
Die im Array angegebenen Inhalte sind auch die Namen der ZielSheets. Das Makro bricht ab, wenn die Zielsheets mit dem Namen 1,2,3 oder 4 nicht vorhanden sind.
Diesen Fehler möchte ich gerne abfangen.
Wenn also eines oder mehrere Sheetnamen aus dem Array nicht existieren, msgbox: "Es fehlen die Zielsheets XY". Bei XY sollen hier die fehlenden Sheets angegeben werden.
Danke für Eure Hilfe.
Chris 

With ActiveWorkbook.Sheets("Test")
.UsedRange.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
For Each X In Array("1", "2", "3", "4")
Set Zelle1 = .Columns(2).Find(What:=X, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlNext)
Set Zelle2 = .Columns(2).Find(What:=X, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious) '
Range(Zelle1, Zelle2).Offset(, -1).Resize(, 6).Copy Worksheets(X).Cells(3, 5)
'End If
Next
End With

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler abfangen
29.12.2021 15:07:38
ChrisL
Hi
Falls es sehr viele Einzelblätter sind, könnte man noch ein wenig optimieren, aber wahrscheinlich reicht es so...

Sub t()
Dim ar As Variant, x As Variant
Dim Zelle1 As Range, Zelle2 As Range
Dim strFehler As String
ar = Array("1", "2", "3", "4")
With ActiveWorkbook.Sheets("Test")
.UsedRange.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
For Each x In ar
If BlattExistiert(x) Then
Set Zelle1 = .Columns(2).Find(What:=x, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlNext)
Set Zelle2 = .Columns(2).Find(What:=x, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious)
Range(Zelle1, Zelle2).Offset(, -1).Resize(, 6).Copy Worksheets(x).Cells(3, 5)
Else
strFehler = strFehler & Chr(10) & x
End If
Next x
If Not strFehler = "" Then MsgBox "Folgende Blätter fehlen und wurden bei der Bearbeitung übersprungen:" & strFehler
End With
End Sub


Private Function BlattExistiert(ByVal strBlatt As String) As Boolean
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = strBlatt Then
BlattExistiert = True
Exit For
End If
Next ws
End Function
cu
Chris
Anzeige
AW: Fehler abfangen
29.12.2021 20:36:02
Chris
Hi ChrisL
das Makro läuft sehr gut!
Wie bei Gerd auch hier die Frage, wie man die Sheetsnamen in einer Variable speichert statt sie im Array festzulegen.
Gruß
Chris
AW: Fehler abfangen
30.12.2021 08:29:49
ChrisL
Hi Chris
Hier noch eine Variante ohne Array. Es werden alle Blätter, mit Ausnahme von "Test" einbezogen:

Sub t()
Dim ws As Worksheet
Dim Zelle1 As Range, Zelle2 As Range
Dim strFehler As String
With ThisWorkbook.Sheets("Test")
.UsedRange.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
For Each ws In ThisWorkbook.Worksheets
If ws.Name  .Name Then
Set Zelle1 = .Columns(2).Find(What:=ws.Name, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlNext)
Set Zelle2 = .Columns(2).Find(What:=ws.Name, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious)
If Zelle1 Is Nothing Or Zelle2 Is Nothing Then
strFehler = strFehler & Chr(10) & ws.Name
Else
Range(Zelle1, Zelle2).Offset(, -1).Resize(, 6).Copy ws.Cells(3, 5)
End If
End If
Next ws
If Len(strFehler) Then MsgBox "Folgende Blätter sind vorhanden, wurden aber in der Tabelle nicht gefunden:" & strFehler
End With
End Sub
cu
Chris
Anzeige
AW: Fehler abfangen
29.12.2021 15:40:49
GerdL
Moin Chris & ChrisL,
3 Fehlerquellen, 2 Abfangjäger ?

Sub Unit()
Dim Zelle1 As Range, Zelle2 As Range, X As Variant
Dim strText As String, strText2 As String
With ActiveWorkbook.Sheets("Test")
.UsedRange.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
For Each X In Array("1", "2", "3", "4")
Set Zelle1 = .Columns(2).Find(What:=X, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlNext)
Set Zelle2 = .Columns(2).Find(What:=X, after:=Range("B1"), Lookat:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious) '
If Zelle1 Is Nothing Or Zelle2 Is Nothing Then
strText = strText & ", " & X
Else
On Error Resume Next
Range(Zelle1, Zelle2).Offset(, -1).Resize(, 6).Copy Worksheets(X).Cells(3, 5)
If Err.Number > 0 Then
strText2 = strText2 & ", " & X
End If
On Error GoTo 0
End If
Next
End With
Set Zelle1 = Nothing: Set Zelle2 = Nothing
If Len(strText) Then MsgBox "Es fehlen Daten für Zielsheets " & Mid$(strText, 3) & " im Blatt ""Test"""
If Len(strText2) Then MsgBox "Es fehlen für vorhandene Daten die Zielsheets: " & Mid$(strText2, 3)
End Sub
Gruß Gerd
Anzeige
AW: Fehler abfangen
29.12.2021 20:34:13
Chris
Hallo Gerd,
danke für die Anpassung. Das läuft sehr gut. Ich habe eine Idee zur Optimierung, weiß aber nicht genau wie ich diese umsetze: Statt im Array die Sheetnamen fest vorzugeben, kann Excel sich die Namen von 4 Sheets (mehr sind es nicht) per Schleife selbst holen und im Array speichern. Man müsste daher die Namen der Sheets in einer Variable speichern:
Etwa so?
dim ws as long, wsn as string
For ws = 1 to 4
wsn=sheets(ws).name
next
MIr fehlt die Kenntnis, wo genau man die Schleife einbaut.
Gruß
Chris
AW: Fehler abfangen
29.12.2021 21:23:09
GerdL
Hallo Chris!

Dim wsn(1 To 4) As Variant, ws As Integer, X As Variant
For ws = 1 To 4
wsn = Sheets(ws).Name
Next
For Each X In wsn
MsgBox X
'Set Zelle 1 = ....
Next
Gruß Gerd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige