Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1076to1080
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
Tabelle Auswerten
20.05.2009 12:09:07
Jaffi
Hallo geliebtes Forum...
nach langer Zeit der selbstversuche muss ich mich mal wieder an die Profis unter euch wenden. Ich hänge immer noch an meinem Wareneingang der jetzt eigentlich fast fertig ist. Nen paar Kleinigkeiten was die Benutzerfreundlichkeit betrifft und dann ab in die Beta-Testphase. ;o)
ABER was mich zum zerplatzen bringt, ist meine Auswertung. Dafür reichen meine mühsam zusammengetragenen VBA-Kenntnisse leider immer noch nicht aus. :o( Ich hoffe sehr das Ihr mir mal wieder mit zahlreichen, hilfreichen Lösungsansätzen helfen könnt:
Folgendes soll passieren:
Nachdem ich nun alle Artikel die reingekommen sind eingescannt habe Zeigt mir die Spalte G meines Tabellenblattes "Wareneingang" (wkseingang) 3 verschiedene Möglichkeiten von Werten. O = Artikelanzahl stimmt, - (Zahl) = Artikel wurde zuwenig geliefert, + (Zahl) = Artikel wurde zuviel geliefert. Die Tabelle wkseingang enthält 7 Spalten ab Zeile 5: (Artnr./Bezeichnung1/Bezeichnung2/Sollmenge/Preis/erfasste Menge/Differenz)
Ein Knopfdruck muss mir nun die die jeweiligen Zeilen raussuchen und in mein Blatt Auswertung entsprechend rüberkopieren. Wks Auswertung enthält 3 Spalten Ab Zeile 4: Artnr./Bezeichnung/Differenz und Ab Zeile 30: Artnr./Bezeichnung/Menge
Einge Artikel müssen mir allerdings nicht als "Differenz" angezeigt werden, da sie nur virtuell eingebucht werden und ich sie garnicht einscannen kann. Diese muss mir das Programm sozusagen selbst zählen. Andere Artikel wiederum sind zwar physisch vorhanden aber müssen gleich wieder von mir ausgebucht werden ( Ich hatte anfangs sehr blauäugig gesagt das ich das selbst hinbekomme, aber denkste...das ist mir zu hoch .. :(
Ich habe mal wieder "Auf Deutsch" zusammengetragen was eigentlich passieren soll. (hat alleine schon nen Tag gedauert ;o) Aber das schreit nach zig Schleifen...und die bekomm ich echt nicht gebacken, das sind einfach zu viele für mich

Im Worksheet "Wareneingang"
Alles ab Spalte 5 abwärts
1. Prüfung
In Spalte F suchen ob ein Wert größer 0 vorhanden
Ja =  Wert gefunden →
weiter mit 2. Prüfung
Nein = Kein Wert gefunden →
MSGBox: Es wurden Keine Daten erfasst!!
2. Prüfung
In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
Ja =  Ein Wert grösser 0 gefunden →
Tabellenblatt "Auswertung" einblenden
Inhalte der Zelle  A, B und G der gefundenen Zeile ins Tabellenblatt „Auswertung“
in letzte freie Zeile ab A4 in Zelle A, B, C kopieren
(Wenn letzte Zeile in Tabellenblatt "Auswertung" größer als A28 ist
muss Zeile eingefügt werden und vorhandene Daten ab Zeile A29 nach unten schieben)
weiter suchen
Nein = Kein Wert grösser 0 gefunden →
weiter mit 3. Prüfung
3. Prüfung
in Spalte G suchen ob ein Wert kleiner als 0 (nicht gleich) gefunden wird
Ja = Ein Wert kleiner 0 gefunden →
gefundene Zeile weiter mit 5. Prüfung
Nein = Kein Wert kleiner 0 gefunden →
weiter mit 4. Prüfung
4. Prüfung
prüfen ob Tabellenblatt "Auswertung" eingeblendet ist
Ja = Tabellenblatt "Auswertung" ist eingeblendet →
Tabellenblatt "Auswertung" aktivieren – Fertig!
Nein = Tabellenblatt "Auswertung" ist ausgeblendet →
MSGBox: Es wurden keine Differenzen festgestellt!!
5. Prüfung
in Zelle E der gefundenen Zeile prüfen ob Wert = 0,00 € ist
Ja = Wert in Zelle E = 0,00 € →
Wert aus Zelle D der gefundenen Zeile in Zelle F der gefundenen Zeile kopieren
nächste Zeile durchsuchen
Nein = Wert in Zelle E ist größer als 0,00 € →
weiter mit 6. Prüfung
6. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zeichenkette "_SE_" vorhanden
Ja = In Zelle B der gefundenen Zeile ist Zeichenkette "_SE_" vorhanden →
Wert aus Zelle D der gefundenen Zeile in Zelle F der gefundenen Zeile kopieren
nächste Zeile durchsuchen
Nein = In Zelle B der gefundenen Zeile ist Zeichenkette "_SE_" nicht vorhanden →
weiter mit 7. Prüfung
7. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zeichenkette "Hardwareschutz" vorhanden
Ja = in Zelle B der gefundenen Zeile ist Zeichenkette "Hardwareschutz" vorhanden →
Wert aus Zelle D der gefundenen Zeile in Zelle F der gefundenen Zeile schreiben
nächste Zeile durchsuchen
Nein = in Zelle B der gefundenen Zeile ist Zeichenkette "Hardwareschutz" nicht vorhanden → _
weiter mit 8. Prüfung
8. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zeichenkette "Zeitschrift" vorhanden
Ja = in Zelle B der gefundenen Zeile ist Zeichenkette "Zeitschrift" vorhanden →
Wert aus Zelle D der gefundenen Zeile in Zelle F der gefundenen Zeile kopieren
nächste Zeile durchsuchen
Nein = in Zelle B der gefundenen Zeile ist Zeichenkette "Zeitschrift" nicht vorhanden →
weiter mit 9. Prüfung
9. Prüfung
in Zelle B neben der gefundenen Zeile prüfen ob Zeichenkette "Sonderheft" vorhanden
Ja = in Zelle B der gefundenen Zeile ist Zeichenkette "Sonderheft" vorhanden →
Wert aus Zelle D der gefundenen Zeile in Zelle F der gefundenen Zeile schreiben
nächste Zeile durchsuchen
Nein = in Zelle B der gefundenen Zeile ist Zeichenkette "Sonderheft" nicht vorhanden →
weiter mit 10. Prüfung
10. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zeichenkette "GRAVIS" vorhanden
Ja = in Zelle B der gefundenen Zeile ist Zeichenkette "GRAVIS" vorhanden →
weiter mit 11. Prüfung
Nein = in Zelle B der gefundenen Zeile ist Zeichenkette "GRAVIS" nicht vorhanden →
Inhalte der Zelle  A, B und G der gefundenen Zeile ins Tabellenblatt „Auswertung“ in letzte
freie Zeile ab A4 in Zelle A, B, C kopieren
(Wenn letzte Zeile in Tabellenblatt "Auswertung" größer als A28 ist muss Zeile eingefügt werden
und vorhandenen Daten ab Zeile A29 nach unten rutschen)
nächste Zeile durchsuchen
11. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zahl "zwischen 1-100" vorhanden
Ja = in Zelle B der gefundenen Zeile ist Zahl "zwischen 1-100" vorhanden →
Inhalte der Zelle  A, B und G der gefundenen Zeile ins Tabellenblatt „Auswertung“ in letzte
freie Zeile ab A4 in Zelle A, B, C kopieren
(Wenn letzte Zeile in Tabellenblatt "Auswertung" größer als A28 ist muss Zeile eingefügt werden
und vorhandenen Daten ab Zeile A29 nach unten rutschen)
nächste Zeile durchsuchen
Nein = in Zelle B der gefundenen Zeile ist Zahl "zwischen 1-100" nicht vorhanden →
weiter mit 12. Prüfung
12. Prüfung
in Zelle B der gefundenen Zeile prüfen ob Zeichen "


Ich hoffe ich habe das verständlich genug aufgeschrieben, habe jetzt schon Kopfschmerzen ;o)
Aber ich denke für die Profis unter euch sollte das verständlich sein, oder?
Bin euch wirklich für jeden Lösungsansatz dankbar. Wenn es zu aufwendig ist würde mir vielleicht auch ein Beispielskript helfen welches ich anpassen könnte...egal was...bin für jeden Strohhalm dankbar der mich endlich zum Abschluss dieses Projektes bringt..
Tausend dank das Ihr mir helft
viele liebe Grüsse
J.

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

Betreff
Datum
Anwender
Anzeige
AW: Tabelle Auswerten
20.05.2009 17:57:09
fcs
Hallo Jaffi,
ich hoffe, dass ich die verschiedeenn Prüfungen korrekt zusammengefasst und geshachtelt hab.
Hier meine Lösung als Fortsezung vom letzten mal.
Gruß
Franz

Option Explicit
Dim wksAusw As Worksheet, wksWE As Worksheet
Dim ZeileAW As Long, ZeileWE As Long
Sub Auswertung()
Dim bolPruef As Boolean, bolPruefNr As Boolean, intNr As Integer
Set wksAusw = Worksheets("Auswertung")
Set wksWE = Worksheets("Wareneingang")
With wksWE
'1. Prüfung
'In Spalte F prüfen ob ein Wert größer 0
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(ZeileWE, 6) > 0 Then
bolPruef = True 'merken, dass Werte in F eingetragen
Exit For
End If
Next
If bolPruef = False Then
MSGBox " Es wurden Keine Daten erfasst!!"
Else
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Wert in Spalte G prüfen
'2. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
If .Cells(ZeileWE, 7) > 0 Then
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
Call KopieABG_nach_ABC
'3. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
ElseIf .Cells(ZeileWE, 7)  0 Then
'6. bis 9. Prüfung Zelle B
If InStr(1, .Cells(ZeileWE, 2), "_SE_") > 0 _
Or InStr(1, .Cells(ZeileWE, 2), "Hardwareschutz") _
Or InStr(1, .Cells(ZeileWE, 2), "Zeitschrift") _
Or InStr(1, .Cells(ZeileWE, 2), "Sonderheft") Then
Cells(ZeileWE, 4).Copy Destination:=Cells(ZeileWE, 6)
Else
'10. Prüfung
If InStr(1, .Cells(ZeileWE, 2), "GRAVIS") > 0 Then
'11.Prüfung 1-100
bolPruefNr = False
For intNr = 1 To 100
If InStr(1, .Cells(ZeileWE, 2).Text, Format(intNr, "0")) > 0 Then
bolPruefNr = True
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
Call KopieABG_nach_ABC
Exit For
End If
Next
If bolPruefNr = False Then '1 bis 100 nicht vorhanden
'12. Prüfung
'in Zelle B der gefundenen Zeile prüfen ob Zeichen " 0 Then
Call KopieABD_nach_ABC
bolPruef = True
Else
bolPruef = True
Call KopieABG_nach_ABC
End If
End If
Else
'GRAVIS nicht vorhanden
bolPruefNr = True
Call KopieABG_nach_ABC
End If
End If
End If
End If
Next
If bolPruef = True Then
wksAusw.Activate
MSGBox "Auswertung Fertig!"
End If
End If
End With
End Sub
Private Sub KopieABG_nach_ABC(Optional ZeileMax As Long = 28)
'Zellen aus Spalten A, B und G nach Auswertung Spalten A bis C kopieren
Dim ZeileMenge As Long
'Ausfüllzeile für Auswertung ermitteln
With wksAusw
'Zeile mit Menge in Überschrift
ZeileMenge = .Columns.Find(What:="Menge", LookIn:=xlValues, lookat:=xlWhole).Row
If ZeileMenge > ZeileMax + 2 Then
ZeileAW = ZeileMenge - 1
.Rows(ZeileAW).Insert
Else
'Frei Zeile oberhalb Zeile 30
ZeileAW = .Cells(ZeileMax + 1, 1).End(xlUp).Row + 1
If ZeileAW = ZeileMax + 1 Then 'Nur noch eine Leerzeile
.Rows(ZeileAW).Insert
End If
End If
wksWE.Cells(ZeileWE, 1).Copy Destination:=.Cells(ZeileAW, 1)
wksWE.Cells(ZeileWE, 2).Copy Destination:=.Cells(ZeileAW, 2)
.Cells(ZeileAW, 3) = wksWE.Cells(ZeileWE, 7).Value
End With
End Sub
Private Sub KopieABD_nach_ABC()
'Zellen aus Spalten A, B und D nach Auswertung Spalten A bis C ans Ende kopieren
With wksAusw
'Ausfüllzeile für Auswertung ermitteln
ZeileAW = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
wksWE.Cells(ZeileWE, 1).Copy Destination:=.Cells(ZeileAW, 1)
wksWE.Cells(ZeileWE, 2).Copy Destination:=.Cells(ZeileAW, 2)
.Cells(ZeileAW, 3) = wksWE.Cells(ZeileWE, 4).Value
End With
End Sub


Anzeige
AW: Tabelle Auswerten
20.05.2009 20:00:23
Jaffi
Ach Franz,
du bist ein riesen Schatz ;o)
Schön wieder von DIR zu lesen.
Habe es probiert ...er ackert auch ganz schön los und im grossen und ganzen funzt es, bis auf das er irgendwie nicht die richtigen Bereiche im Blatt auswertung befüllt. Er schreibt alles rein ab Zeile 29. Habe das Blatt wohl schlecht aufgeteilt...mh..muss ich mir genauer anschauen
Nur hatte ich natürlich einen Denkfehler der eindeutig ist :(
Es gibt auch Datensätze die in E 0,00 € UND ein "grösserals" in Zelle B haben. Die 0,00 € Prüfung überträgt mir nun aber natürlich die Sollmenge in die erfasste Menge. Aber er muss mir ja ALLE Datensätze mit "grösserals" in Zelle B ins Tabellenblatt Auswertung Ab A31 schreiben. Diese und zwar nur diese muss ich nämlich manuell verbuchen. Deswegen keine wirkliche Differenz sondern nur gesondert aufgelistet. Er sollte also vor dem automatischen befüllen der Menge schauen ob ein "grösserals" In Zelle B vorhanden ist. und dann entsprechend rüberkopieren. Ich wusste das ich doch! einen Denkfehler in meiner "deutschen Prozedur" habe :( mhm..verd****
Werde den Rest dann morgen ausgiebig Testen....und mich dann schnellstmöglich melden..
Tausend Dank für Deine Hilfe Franz!
ganz liebe Grüsse
:*
J.
Anzeige
AW: Tabelle Auswerten
25.05.2009 12:03:12
fcs
Hallo Jaffi,
mit folgenden Anpasungen sollte das Kopieren ans Ende funktionieren,
wenn Spalte = 0 und in Spalte B ein "kleiner Zeichen"
Etwas einfacher könnte man das Kopieren gestalten, wenn du für die Auswertung zwei separate Tabellenblätter hättest ( eins für die Artikel mit Differenzen, eins für die manuell zu erfassenden Artikel.
Dann muss man nicht so kompliziert die Einfügezeile für die Artikel mit Differenzen ermitteln, sondern kann "einfach" immer am Ende der Liste anfügen.
Gruß Franz

Dim wksAusw As Worksheet, wksWE As Worksheet
Dim ZeileAW As Long, ZeileWE As Long
Sub AuswertungNeu()
Dim bolPruef As Boolean, bolPruefNr As Boolean, intNr As Integer
Set wksAusw = Worksheets("Auswertung")
Set wksWE = Worksheets("Wareneingang")
With wksWE
'1. Prüfung
'In Spalte F prüfen ob ein Wert größer 0
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(ZeileWE, 6) > 0 Then
bolPruef = True 'merken, dass Werte in F eingetragen
Exit For
End If
Next
If bolPruef = False Then
MSGBox " Es wurden Keine Daten erfasst!!"
Else
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Wert in Spalte G prüfen
'2. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
If .Cells(ZeileWE, 7) > 0 Then
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
If (Not IsEmpty(.Cells(ZeileWE, 5))) And .Cells(ZeileWE, 5) = 0 Then
If InStr(1, .Cells(ZeileWE, 2), " 0 Then
Call KopieABG_nach_ABC_Ende
bolPruef = True
End If
Else
Call KopieABG_nach_ABC
End If
'3. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
ElseIf .Cells(ZeileWE, 7)  0 Then
Call KopieABG_nach_ABC_Ende
bolPruef = True
Else
Cells(ZeileWE, 4).Copy Destination:=Cells(ZeileWE, 6)
End If
ElseIf .Cells(ZeileWE, 5) > 0 Then
'6. bis 9. Prüfung Zelle B
If InStr(1, .Cells(ZeileWE, 2), "_SE_") > 0 _
Or InStr(1, .Cells(ZeileWE, 2), "Hardwareschutz") _
Or InStr(1, .Cells(ZeileWE, 2), "Zeitschrift") _
Or InStr(1, .Cells(ZeileWE, 2), "Sonderheft") Then
Cells(ZeileWE, 4).Copy Destination:=Cells(ZeileWE, 6)
Else
'10. Prüfung
If InStr(1, .Cells(ZeileWE, 2), "GRAVIS") > 0 Then
'11.Prüfung 1-100
bolPruefNr = False
For intNr = 1 To 100
If InStr(1, .Cells(ZeileWE, 2).Text, Format(intNr, "0")) > 0 Then
bolPruefNr = True
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
Call KopieABG_nach_ABC
Exit For
End If
Next
If bolPruefNr = False Then '1 bis 100 nicht vorhanden
'12. Prüfung
'in Zelle B der gefundenen Zeile prüfen ob Zeichen " 0 Then
Call KopieABD_nach_ABC
bolPruef = True
Else
bolPruef = True
Call KopieABG_nach_ABC
End If
End If
Else
'GRAVIS nicht vorhanden
bolPruefNr = True
Call KopieABG_nach_ABC
End If
End If
End If
End If
Next
If bolPruef = True Then
wksAusw.Activate
MSGBox "Auswertung Fertig!"
End If
End If
End With
End Sub
Private Sub KopieABG_nach_ABC(Optional ZeileMax As Long = 28)
'Zellen aus Spalten A, B und G nach Auswertung Spalten A bis C kopieren
Dim ZeileMenge As Long
'Ausfüllzeile für Auswertung ermitteln
With wksAusw
'Zeile mit Menge in Überschrift
ZeileMenge = .Columns.Find(What:="Menge", LookIn:=xlValues, lookat:=xlWhole).Row
If ZeileMenge > ZeileMax + 2 Then
ZeileAW = ZeileMenge - 1
.Rows(ZeileAW).Insert
Else
'Frei Zeile oberhalb Zeile 30
ZeileAW = .Cells(ZeileMax + 1, 1).End(xlUp).Row + 1
If ZeileAW = ZeileMax + 1 Then 'Nur noch eine Leerzeile
.Rows(ZeileAW).Insert
End If
End If
wksWE.Cells(ZeileWE, 1).Copy Destination:=.Cells(ZeileAW, 1)
wksWE.Cells(ZeileWE, 2).Copy Destination:=.Cells(ZeileAW, 2)
.Cells(ZeileAW, 3) = wksWE.Cells(ZeileWE, 7).Value
End With
End Sub
Private Sub KopieABD_nach_ABC()
'Zellen aus Spalten A, B und D nach Auswertung Spalten A bis C ans Ende kopieren
With wksAusw
'Ausfüllzeile für Auswertung ermitteln
ZeileAW = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
wksWE.Cells(ZeileWE, 1).Copy Destination:=.Cells(ZeileAW, 1)
wksWE.Cells(ZeileWE, 2).Copy Destination:=.Cells(ZeileAW, 2)
.Cells(ZeileAW, 3) = wksWE.Cells(ZeileWE, 4).Value
End With
End Sub
Private Sub KopieABG_nach_ABC_Ende()
'Zellen aus Spalten A, B und G nach Auswertung Spalten A bis C ans Ende kopieren
With wksAusw
'Ausfüllzeile für Auswertung ermitteln
ZeileAW = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
wksWE.Cells(ZeileWE, 1).Copy Destination:=.Cells(ZeileAW, 1)
wksWE.Cells(ZeileWE, 2).Copy Destination:=.Cells(ZeileAW, 2)
.Cells(ZeileAW, 3) = wksWE.Cells(ZeileWE, 7).Value
End With
End Sub


Anzeige
AW: Tabelle Auswerten
25.05.2009 16:23:04
Jaffi
Hallo Franz ;)
Hm , das mit den Zwei Tabellen hab ich mir auch schon gedacht...zumal er mir die Tabellen irgenwie seltsam verschiebt...WENN er mehr wie 30 Zeilen im ersten Teil der AuswertungsTabelle hat. Kommt zwar so gut wie nie vor...aber es kann eben passieren. Mir fehlt dann immer der dünne Rahmen ab der Zeile die neu eingefügt werden muss :( Aber ich brauche aber jede Differenz auf EINEN Ausdruck, deswegen muss es auf einem Blatt sein :(
Franz hab doch noch was übersehen... :( sorry...er soll mir zwar die "Differenz" mit 0 und kleinerals in den unteren Teil der Auswertung schreiben ABER die Sollmenge muss trotzdem automatisch eingetragen werden. Das auf dem Blatt Wareneingang grundlegend nicht zu erkennen ist das es nicht gezählt wurde.
Sprich: ist 0? ist "kleinerals" dann Menge befüllen UND ins Blatt Auswertung unterhalb der Zeile 30...
sorry Franz wenns nervt aber seh bald nicht mehr durch :/
Aber dank Deiner Hilfe ists bald geschafft ;)
:*
10000000 mal Danke!!!
Anzeige
AW: Tabelle Auswerten
25.05.2009 19:28:19
fcs
Hallo Jaffi,
ich hab an den beiden relevanten Stellen noch jeweisl eine Zeile eingefügt, die die gescannte Menge in die Soll-Mengen-Spalte kopiert.
Das Problem mit der Rähmchen-Formatierung beim Einfügen weiterer Zeilen vor Zeile 29 kann ich im Blindflug nicht lösen.
Gruß
Franz
Hier die modifizierte Hauptprozedur. Neue und geänderte Zeilen sind markiert.

Sub AuswertungNeu()
Dim bolPruef As Boolean, bolPruefNr As Boolean, intNr As Integer
Set wksAusw = Worksheets("Auswertung")
Set wksWE = Worksheets("Wareneingang")
With wksWE
'1. Prüfung
'In Spalte F prüfen ob ein Wert größer 0
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(ZeileWE, 6) > 0 Then
bolPruef = True 'merken, dass Werte in F eingetragen
Exit For
End If
Next
If bolPruef = False Then
MSGBox " Es wurden Keine Daten erfasst!!"
Else
bolPruef = False
For ZeileWE = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Wert in Spalte G prüfen
'2. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
If .Cells(ZeileWE, 7) > 0 Then
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
If (Not IsEmpty(.Cells(ZeileWE, 5))) And .Cells(ZeileWE, 5) = 0 Then
If InStr(1, .Cells(ZeileWE, 2), " 0 Then
Call KopieABG_nach_ABC_Ende
.Cells(ZeileWE, 6).Copy Destination:=.Cells(ZeileWE, 4) 'neu Fcs ###
bolPruef = True
End If
Else
Call KopieABG_nach_ABC
End If
'3. Prüfung
'In Spalte G suchen ob ein Wert grösser als 0 (nicht gleich) gefunden wird
ElseIf .Cells(ZeileWE, 7)  0 Then
Call KopieABG_nach_ABC_Ende
.Cells(ZeileWE, 6).Copy Destination:=.Cells(ZeileWE, 4) 'neu Fcs ###
bolPruef = True
Else
.Cells(ZeileWE, 4).Copy Destination:=.Cells(ZeileWE, 6) 'mod Fcs ###
End If
ElseIf .Cells(ZeileWE, 5) > 0 Then
'6. bis 9. Prüfung Zelle B
If InStr(1, .Cells(ZeileWE, 2), "_SE_") > 0 _
Or InStr(1, .Cells(ZeileWE, 2), "Hardwareschutz") _
Or InStr(1, .Cells(ZeileWE, 2), "Zeitschrift") _
Or InStr(1, .Cells(ZeileWE, 2), "Sonderheft") Then
.Cells(ZeileWE, 4).Copy Destination:=.Cells(ZeileWE, 6)
Else
'10. Prüfung
If InStr(1, .Cells(ZeileWE, 2), "GRAVIS") > 0 Then
'11.Prüfung 1-100
bolPruefNr = False
For intNr = 1 To 100
If InStr(1, .Cells(ZeileWE, 2).Text, Format(intNr, "0")) > 0 Then
bolPruefNr = True
bolPruef = True 'merken, dass Differenzen (4. Prüfung)
Call KopieABG_nach_ABC
Exit For
End If
Next
If bolPruefNr = False Then '1 bis 100 nicht vorhanden
'12. Prüfung
'in Zelle B der gefundenen Zeile prüfen ob Zeichen " 0 Then
Call KopieABD_nach_ABC
bolPruef = True
Else
bolPruef = True
Call KopieABG_nach_ABC
End If
End If
Else
'GRAVIS nicht vorhanden
bolPruefNr = True
Call KopieABG_nach_ABC
End If
End If
End If
End If
Next
If bolPruef = True Then
wksAusw.Activate
MSGBox "Auswertung Fertig!"
End If
End If
End With
End Sub


Anzeige
AW: Tabelle Auswerten
26.05.2009 14:06:13
Jaffi
Hallo Franz,
Danke für Deine Änderung. Hatte das gestern Nacht tatsächlich schon selbst hinbekommen :D
Hab viel gelernt...auch durch Deine Hilfe..
Jetzt hab ich es bald geschafft ;)
vielen, vielen Dank für deine tatkräftige Unterstützung, du hast mir wirklich sehr geholfen
lg und bestimmt bis bald :)
J.

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige