Spalten vergleichen und Ausgabe in neues Worksheet

Hallo liebe Community,
ich habe hier eine Tabelle in der in Zeile 4 verschiedene Daten (von Datum) stehen.
Bsp.:
C4+D4=01.01.2009 / E4+F4=02.01.2009 / G4+H4=03.01.2009 usw.
So in C5 und D5 (...) stehen Werte. Es gibt immer für jeden Tag 2 Werte.
Nun soll das Makro die beiden Spalten eines Tages miteinander vergleichen und bei Abweichungen der Werte ein neues Tabellenblatt erstellen, welches den Namen des jeweiligen Datums trägt und als Wert die beiden Werte aus C5 und D5 ausgibt.
Bsp.:
C4+D4=01.01.2009 und
C5="2 Watt" D5="3 Watt"
Wenn hier jetzt ein Fehler auftritt, soll ein Tabellenblatt mit dem Namen "01.01.2009" erstellt werden. Und es soll 2 Werte besitzen: nämlich "2 Watt" und "3 Watt".
Allerdings sind es ganz viele Werte untereinander, also z.B. C5 ="2 Watt" C6="7 Amper" C7="5 V" usw....
Wenn jetzt an einem Tag mehrere Werte falsch sind sollen die in dem erstellten Worksheet auch untereinander stehen.
Phew! Hoffe ich habe mich nicht zu verquer ausgedrückt... Smile
Falls irgenjemand ne Ahnung hat wie man das angehen könnte:
ICH FREU MICH ÜBER JEDE HILFE!
Danke im Voraus
lg
Bolo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Franz,
danke fürs lesen :) aber ich habe es schon hinbekommen....
Wen es interessiert:


Sub FehlerSuche()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngS As Long
Dim lngZ As Long
Dim lngLZQ As Long
Dim lngLSQ As Long
Dim lngLZZ As Long
Dim lngLSZ As Long
Dim bolFehlerExist As Boolean
Dim lngZeileStart As Long
Dim lngSpalteStart As Long
Dim strTabName As String
'[C4] ggf. Anpassen
lngZeileStart = 4
lngSpalteStart = 4
Set wksQ = Worksheets("Tabelle1") 'ggf. Anpassen
lngLSQ = wksQ.Cells(lngZeileStart, wksQ.Columns.Count).End(xlToLeft).Column
For lngS = lngSpalteStart To lngLSQ Step 2
strTabName = wksQ.Cells(lngZeileStart, lngS).Value
On Error Resume Next
Set wksZ = Worksheets(strTabName)
If Err.Number  0 Then
Err.Clear
Set wksZ = Worksheets.Add(After:=Sheets(Sheets.Count))
wksZ.Name = strTabName
End If
wksZ.Cells.Clear
lngLZQ = wksQ.Cells(wksQ.Rows.Count, lngS).End(xlUp).Row
For lngZ = lngZeileStart + 1 To lngLSQ
If wksQ.Cells(lngZ, lngS).Value  wksQ.Cells(lngZ, lngS + 1).Value Then
wksZ.Cells(lngLZZ + 1, lngLSZ + 1).Value = wksQ.Cells(lngZ, 3).Value
wksZ.Cells(lngLZZ + 1, lngLSZ + 2).Value = wksQ.Cells(lngZ, lngS).Value
wksZ.Cells(lngLZZ + 1, lngLSZ + 3).Value = wksQ.Cells(lngZ, lngS + 1).Value
lngLZZ = wksZ.Cells(wksZ.Rows.Count, lngLSZ + 1).End(xlUp).Row
If WorksheetFunction.CountA(wksZ.Range("A:A")) > 1 Then
bolFehlerExist = True
End If
End If
Next
If bolFehlerExist Then
bolFehlerExist = False
'lngLSZ = lngLSZ + 2
Else
Application.DisplayAlerts = False
wksZ.Delete
Application.DisplayAlerts = True
End If
lngLZZ = 0
Next
End Sub

Beliebteste Forumthreads (12 Monate)

Spalten vergleichen und Ausgabe in neues Worksheet

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten vergleichen und Ausgabe in neues Worksheet

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread