Registriert seit: 10.04.2014
Version(en): 2016 + 365
20.07.2015, 14:47
(Dieser Beitrag wurde zuletzt bearbeitet: 20.07.2015, 14:48 von Rabe.)
Hi, jetzt versuche ich es auch noch: (20.07.2015, 13:48)karomue schrieb: Irgendwie verstehen wir uns nicht, woran das wohl liegt???
Ich habe dazu jetzt schon wiederholt geschrieben: das ist eine neue Schleife, warum siehst du das nicht??? Du willst mir immer beweisen ,dass ich einen Fehler gemacht habe: also nochmal: DAS IST MIT ÜBERWACHUNG IM EINZELSCHRITTVERFAHREN GEPRÜFT, UND ES LÄUFT EINWANFREI, BIS EBEN AUF DIE TATSACHE, DASS DIE ERSTE LEERE zELLE IN REIHE 76 NICHG GEFUNDEN WIRD:
Mal ne schüchterne Frage: lesen kannst du aber schon, oder? hier Dein Code-Teil mit der For-Schleife, gekürzt um ausgeblendete Zeilen: For l = 1 To 30 ' Beginn For
If Cells(j + l, 3).Value <> "" Then ' Beginn Schleife 1
Cells(j + l, 3).Select
If Cells(j + l, 3).Value = " " Then ' Beginn Schleife 2 innerhalb Schleife 1
Stop
End If ' Ende Schleife 2 innerhalb Schleife 1
a = ""
zaehl = j + l
Cells(zaehl, 3).Select
End If ' Ende Schleife 1
Next l ' Ende For
VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel Code erstellt und getestet in Office 15 Die Schleife 2 ist zwar eine neue Schleife, die aber im True-Teil der Schleife 1 (Value <>"") läuft. Wenn Du dann in der Schleife 2 auf Value = "" prüfst, kann es dort niemals ein True geben. Und das ist genau das, was Stefan dauernd schreibt! Eher geht es so (ungetestet, da ohne Datei): For l = 1 To 30 ' Beginn For
If Cells(j + l, 3).Value <> "" Then ' Beginn Schleife 1
Cells(j + l, 3).Select
Else
' If Cells(j + l, 3).Value = " " Then ' Beginn Schleife 2 innerhalb Schleife 1
Stop
' End If ' Ende Schleife 2 innerhalb Schleife 1
a = ""
zaehl = j + l
Cells(zaehl, 3).Select
End If ' Ende Schleife 1
Next l ' Ende For
VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel Code erstellt und getestet in Office 15
Registriert seit: 10.04.2014
Version(en): Microsoft 365, mtl. Kanal
Hi Charly,
hier, in diesem Forum, geben alle Helfer ihr Bestes, um einem Fragesteller zu einer Lösung seines Problems zu verhelfen. Und das geschieht alles unentgeltlich in der Freizeit des einzelnen. Wir alle machen das aus reiner Freude und aus Spaß am Exceln.
Und nun bitte ich dich, das Ganze einmal aus der Sicht eines Helfers zu betrachten. Eine Metapher soll helfen, das aus dieser Sicht Gewonnene zu verstehen.
In einer Stadt haben die Inhaber der Autowerkstätten beschlossen, Tipps, Tricks und Hilfen kostenlos an alle Autofahrer abzugeben. Gedacht war dabei, dass der Hilfesuchende, nennen wir ihn einfach Anton, sich eine Werkstatt aussucht und dort mit seinem Problem vorstellig wird.
Anton, der scheinbar einiges von seinem Gefährt versteht, bemühte die Mitarbeiter des ersten Autohauses (Weiß-Blau) und stellte seine Frage, warum denn das Licht an seinem Fahrzeug nicht ginge. Es gingen Tipps und Fragen ein nach dem Motto:
Hast du die Sicherungen überprüft?
Schau mal nach dem Glühfaden der Lampe.
Sitzt die Lampe richtig in ihrer Halterung?
Auf alles wusste Anton eine Antwort und wiederholte aber stereotyp, dass sein Licht nicht brenne. Nun forderte ein Mitarbeiter von Weiß-Blau Anton auf, mit seinem Wagen vorzufahren, da alle Tipps ein Stochern im Nebel waren. Mit einer Nachschau wäre das Problem sicherlich in kürzester Zeit behoben. Doch Anton, ganz sicher nicht unter mangelndem Selbstbewusstsein leidend, war der Ansicht, dass das nichts bringe, da ja nicht das Auto, sondern nur etwas im Bereich der Beleuchtung defekt sei.
Da die Mitarbeiter, zugegebenermaßen etwas genervt, wiederholt aufforderten, das Auto zur Verfügung zu stellen, wechselte Anton kurzerhand zur Werkstatt Nippon und stelle den dortigen Mitarbeitern dieselbe Frage wie im Haus Weiß-Blau.
Doch, wie kann das sein, auch hier verlangten die Helfer nach einigem Hin und Her nach dem Fahrzeug und warteten mit fast identischen Gründen auf. Irgendwie muss Anton das dann missverstanden haben und gab seinen Worten ein Gewicht, das die Helfer nicht zu tragen bereit waren. Auch sie konterten zum Teil ge-, ja schon fast entnervt mit nachdrücklichem Ton.
Aber sind die Helfer wirklich nicht imstande, so eine Beleuchtungseinheit auch per Ferndiagnose wieder zum Leuchten zu bringen? Oder haben die Helfer einfach keinen Bock? Ich glaube nicht, denn alle, die in diesen Werkstätten unentgeltlich – zum Teil auch nachts – mit Rat und Tat den Fragern zur Seite stehen, tun dies aus reinem Spaß an der Freude. Es ist ihr Hobby!
Doch wie kann man Anton nun dazu bringen, dass er mal etwas nachdenkt und den Helfern Recht gibt mit ihrer Meinung, dass nur durch Kenntnis der gesamten Situation, sprich durch Inaugenscheinnahme des ganzen (!) Fahrzeugs adäquate Hilfe geleistet werden kann? Denn schließlich machen sie das alles schon seit vielen, vielen Jahren. Und in der Regel immer erfolgreich. An den Helfern kann es also nicht liegen. Und am Fragesteller?
Nun, das sollte Anton schon selbst herausfinden. Sicherlich hilft dabei ein stetes freundliches Wort, eine fruchtbare Kooperation, und die Einsicht, dass niemand ihm schaden oder aus Jux und Tollerei das Auto begutachten will.
Und so könnte die Lösung für Antons Problem aussehen:
1. Er entscheidet sich, das Auto nicht vorzustellen und beharrt auf seiner Meinung, dass gute Mechaniker den Fehler auch so finden müssen. Auch auf die Gefahr hin, dass der beste und gutmütigste unter ihnen irgendwann die Lust verliert, weil er partout nichts zur Suche in der Hand hat.
2. Er entscheidet sich, das Fahrzeug vorzufahren und es den Helfern zur Begutachtung zur Verfügung zu stellen. Diese sehen sich alle möglichen Fehlerquellen an. Einer von ihnen entdeckt dann ganz versteckt eine blanke Kabelstelle, die die Ursache für all die unnötigen vorausgegangenen Fragen, Nachfragen, unschöne Töne und dergleichen, war. Bei sofortiger Kenntnis dieses Defekts hätte die ganze Hilfsaktion längst abgeschlossen sein können. Einem nächsten Hilfesuchenden könnte geholfen werden.
Hi Charly,
ist zwar ein langer Text geworden, nicht fachgebunden, aber aus meiner Sicht hilfreich, etwas Schärfe aus den Tönen heraus zu nehmen. Bitte denke wirklich daran, dass dir geholfen wird, aber der Helfer entscheidet, was er dazu benötigt.
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
Registriert seit: 19.07.2015
Version(en): 365/2016
Hallo WillWissen.
Schönes Beispiel. Aber es hinkt.
Schau mal: ich habe einen Code der in einer Spalte mit (Datumszellen) das die 1. Zelle finden muss, die belegt ist: dieser Teil läuft.
Danach muss die erste Zelle gefunden werden, die leer ist. Das Makro läuft in diesem Schleifenteil leider über die leere Zelle hinaus und stoppt nicht, es macht hier absolut keinen Sinn, das komplette Makro hier rein zu stellen. Bedauerlich, dass man immer darauf rumhackt das Makro zu kriegen, obwohl es überhaupt nichts zu Klärung beiträgt.
Belegt ist das ganze über Überwachungsausdrücke (die sich leider nicht kopieren lassen) in der alle Variablen i,j,k,l, alle cells... .values die interessant sind, vergl, zaehl und lRow aufgenommen wurden. Ich weiß also sehr genau was wann/wo passiert, so ist z.B. wenn die Schleife an der leeren Zelle ankommt der Typ Variant/Empty. Nun scheitern alle versuchten Abfragen - wobei alleine eigentlich schon {= ""} reichen sollte. Das sollten sich die Helfer mal g a n z langsam auf der Zunge zergehen lasse. Wundert Dich noch, dass ich schon ne Weile sauer bin? Um auf Dein Beispiel zurückzukommen: hier hilft das Auto wirklich nichts. Aber vielleicht glaubst Du mir ja.... Oder siehst Du das anders, was könnte ich denn noch tun zur Klärung? Mir fällt nix mehr ein, bin dabei aufzugeben. Außer Anfeindungen nix gewesen...
LG, Charly
Registriert seit: 19.07.2015
Version(en): 365/2016
(20.07.2015, 14:47)Rabe schrieb: Hi,
jetzt versuche ich es auch noch:
(20.07.2015, 13:48)karomue schrieb: Irgendwie verstehen wir uns nicht, woran das wohl liegt???
Ich habe dazu jetzt schon wiederholt geschrieben: das ist eine neue Schleife, warum siehst du das nicht??? Du willst mir immer beweisen ,dass ich einen Fehler gemacht habe: also nochmal: DAS IST MIT ÜBERWACHUNG IM EINZELSCHRITTVERFAHREN GEPRÜFT, UND ES LÄUFT EINWANFREI, BIS EBEN AUF DIE TATSACHE, DASS DIE ERSTE LEERE zELLE IN REIHE 76 NICHG GEFUNDEN WIRD:
Mal ne schüchterne Frage: lesen kannst du aber schon, oder?
hier Dein Code-Teil mit der For-Schleife, gekürzt um ausgeblendete Zeilen:
For l = 1 To 30 ' Beginn For
If Cells(j + l, 3).Value <> "" Then ' Beginn Schleife 1
Cells(j + l, 3).Select
If Cells(j + l, 3).Value = " " Then ' Beginn Schleife 2 innerhalb Schleife 1
Stop
End If ' Ende Schleife 2 innerhalb Schleife 1
a = ""
zaehl = j + l
Cells(zaehl, 3).Select
End If ' Ende Schleife 1
Next l ' Ende For
VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel Code erstellt und getestet in Office 15
Die Schleife 2 ist zwar eine neue Schleife, die aber im True-Teil der Schleife 1 (Value <>"") läuft.
Wenn Du dann in der Schleife 2 auf Value = "" prüfst, kann es dort niemals ein True geben.
Und das ist genau das, was Stefan dauernd schreibt!
Eher geht es so (ungetestet, da ohne Datei):
For l = 1 To 30 ' Beginn For
If Cells(j + l, 3).Value <> "" Then ' Beginn Schleife 1
Cells(j + l, 3).Select
Else
' If Cells(j + l, 3).Value = " " Then ' Beginn Schleife 2 innerhalb Schleife 1
Stop
' End If ' Ende Schleife 2 innerhalb Schleife 1
a = ""
zaehl = j + l
Cells(zaehl, 3).Select
End If ' Ende Schleife 1
Next l ' Ende For
VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel Code erstellt und getestet in Office 15 Hallo Ralf, nein, so geht das nicht. Wie jetzt schon mehrfach gepostet. Nimms nich übel. aber ich bin es langsam leid bei jedem der sich hier äußert immer wiede die gleichen Einwände zu schreiben.
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo, Zitat:Nun scheitern alle versuchten Abfragen - wobei alleine eigentlich schon {= ""} reichen sollte ... wobei die Zelle, in der das steht eben nicht leer ist. Da steht eine Formel drin. Aber mach mal, Du schaffst das schon.
Registriert seit: 03.09.2014
Version(en): 2016
Du willst es einfach nicht verstehen. Schade
Ich hoffe nur, Du kommst mal nicht in so eine Situation wie wir, wenn ja kannst Du uns dann sicher verstehen oder auch nicht.
Ich bin raus :16:
Registriert seit: 19.07.2015
Version(en): 365/2016
Äh, was ssoll da für eine Formel drin stehen? Die Tabelle wird über Access generiert mit
Select Case Monatswert
Case "1", "01", " 1"
DoCmd.OutputTo acOutputReport, "DatumAbfrageAusgaben", acFormatXLS, _
"DatumAbfrageAusgabenJanuar" & Jahreswert & ".xls", True
da kommt keine Formel vor und Excel generiert sicher keine nur aus Jux und Topllerei.
Registriert seit: 19.07.2015
Version(en): 365/2016
(20.07.2015, 16:27)Fred0 schrieb: Du willst es einfach nicht verstehen. Schade
Ich hoffe nur, Du kommst mal nicht in so eine Situation wie wir, wenn ja kannst Du uns dann sicher verstehen oder auch nicht.
Ich bin raus :16: Ich würde in diesem Fall mal genau lesen und mir eine eigene Prüfmöglichkeit überlegen...
Registriert seit: 10.04.2014
Version(en): Microsoft 365, mtl. Kanal
Hi Charly, fachlich gesehen kann ich dazu absolut nichts sagen - ich kenne mich in der Materie VBA zu wenig aus. Aber was hindert dich denn wirklich, deine Datei, natürlich anonymisiert, den Helfern zur Verfügung zu stellen. Ich schrieb ja in meinem kleinen Beitrag (ähmm), dass die Helfer entscheiden müssen, was sie benötigen. Zitat:Nun scheitern alle versuchten Abfragen - wobei alleine eigentlich schon {= ""} reichen sollte. Ich meine gelesen zu haben, dass die Frage auftauchte, ob die Zellen tatsächlich leer sind. Das zu prüfen wäre mit der Datei bestimmt ein Leichtes. Glaub' mir, niemand, aber auch wirklich niemand hier, feindet dich an. Du merkst doch selber, dass immer wieder Vorschläge kommen, jedoch nicht dem entsprechen, was du benötigst. In diesem Sinn will ich mit den folgenden Punkten diese Diskussion abschließen: - Wenn es keine nachvollziehbaren Hinderungsgründe gibt, dann komme doch der Bitte der Helfer nach der Datei nach. Es ist doch nur zu deinem Vorteil - Bedenke bitte, dass die Helfer entscheiden müssen, was sie für ihre Hilfe selber benötigen. Du kennst deine Datei, du weißt, wo was steckt. Erklärungen werden dann mit genau diesem eigenen Wissen abgegeben - ein Nichteingeweihter fängt eventuell mit diesen Erklärungen nichts an oder kann diesen ohne weitere Einblicke nicht folgen. - unschöne Töne sollten (natürlich von allen Seiten) grundsätzlich vermieden werden. - Last, but not least - du suchst Hilfe. Mit entsprechender Mitwirkung wirst du sie auch sicherlich bald haben. In diesem Sinne ziehe ich mich aus dieser Diskussion zurück und lese nur noch mit. Natürlich drücke ich dir alle  damit du bald deine Lösung hast.
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
Registriert seit: 19.07.2015
Version(en): 365/2016
Code: Private Const Schriftart As String = "Arial"
Private Const Schriftgroesse As Integer = 8 'ColorIndex
Private Const ColorIndgelb As Integer = 6
Private Const ColorIndrot As Integer = 46
Private Const ColorIndgrün As Integer = 4
Private i As Integer
Private Korr As Integer
Dim ExcelSheet As Object
Dim Zuordng(1 To 16, 1 To 2) As String '("Arbeitsmittel","Computer"), 1 für Monatsblatt, 2 für Jahresblatt
Dim Monatsfeld(1 To 12) 'Hilfsfeld für SummeMonatGruppe
Dim SummeMonatGruppe(1 To 12, 1 To 11) As String '12 Monate/11Gruppen=Arbeitsmittel, Computer
Dim LenJahrMonat(1 To 16, 1 To 2) As Integer 'AnzahlGruppeneinträge/Anzahl (Jahr-Monat)
Dim EndPosJahrMonat(1 To 16, 1 To 2) As Integer
Dim DateiName As String
Dim Jahr As String
Dim FileName As String
Dim RehaSum As Variant
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
'declare PtrSafe....
Dim lRow As Long
Sub AusgabeAktuell()
'K.R. Müller, erstellt im April 1998
'hier für 2001 geändert
'geändert 11.9.2000
'geändert für allgem. Jahreseingabe 15.1.2001
'letzte Änderung 20.1.2002
'
Dim Vertical As Integer
Dim WertJahr As Single
Dim WertMonat As Single
Dim AktuelleMappe As String
Dim AktuellesFenster As String
Anzeigejahr = Mid$(Now, 7, 4)
Jahr = InputBox("Bitte Auswerte-Jahr eingeben: z.B. 2000, 2001" + Chr(13) + Chr(10) + _
Chr(10) + ">>Entspr. Ausgabe-File muß geöffnet sein!<<", "Jahres-Abfrage ", Anzeigejahr)
Anzeigemonat = Mid$(Now, 4, 2)
Monat = InputBox("Bitte Auswerte-Monat eingeben: z.B. Januar/Jan/jan/1 ...", "Monats-Abfrage", Anzeigemonat)
M1 = "DatumAbfrageAusgaben"
M2 = Right(Jahr, 2) + ".xls"
'ChDir "Arbeitsplatz" ' "E_Platte\Excel_MP"
'AusgabenFileSuchen
Select Case HolComputerName
Case "CHARLY-PC"
DateiName = "D:\Neuer Aktenkoffer\Ausgaben " & Jahr & ".xls"
Case "CHARLYS-NB"
'DateiName = "D:\Aktenkoffer\Ausgaben " & Jahr & ".xls"
DateiName = "c:\Benutzer\karomue\EigeneDokumente\Aktenkoffer\Ausgaben " & Jahr & ".xlsx"
Case "ROBERT1"
DateiName = "E:\EXCEL_MP\Ausgaben " & Jahr & ".xls"
Case "KAROMUE-NB"
'DateiName = "C:\Benutzer\karomue\EigeneDokumente\Aktenkoffer\Ausgaben " & Jahr & ".xls"
'DateiName = "C:\Users\karomue\Documents\Aktenkoffer\Ausgaben " & Jahr & ".xls"
'DateiName = "C:\Users\karomue\Eigene Dokumente\Aktenkoffer\Ausgaben " & Jahr & ".xls"
DateiName = "C:\Users\karomue\Documents\Aktenkoffer\Ausgaben " & Jahr & ".xls"
End Select
'If HolComputerName = "CHARLY-PC" Then
' DateiName = "D:\Neuer Aktenkoffer\Ausgaben " & Jahr & ".xls"
'*Else
' DateiName = "E:\EXCEL_MP\Ausgaben " & Jahr & ".xls"
'End If
'DateiName = "C:\Users\karomue\Documents\Aktenkoffer\Ausgaben " & Jahr & ".xls"
'ChDir "C:\WIN98\Desktop\Aktenkoffer"
'Workbooks.Open FileName:="C:\WIN98\Desktop\Aktenkoffer\Ausgaben2002.xls"
Workbooks.Open FileName:=DateiName
Select Case Left(Monat, 3)
Case "Jan", "jan", "1", "1 ", "1 ", "01"
Monat = "Januar"
Case "Feb", "feb", "2", "2 ", "2 ", "02"
Monat = "Februar"
Case "Mar", "mar", "Mär", "mär", "3", "3 ", "3 ", "03"
Monat = "März"
Case "Apr", "apr", "4", "4 ", "4 ", "04"
Monat = "April"
Case "Mai", "mai", "5", "5 ", "5 ", "05"
Monat = "Mai"
Case "Jun", "jun", "6", "6 ", "6 ", "06"
Monat = "Juni"
Case "Jul", "jul", "7", "7 ", "7 ", "07"
Monat = "Juli"
Case "Aug", "aug", "8", "8 ", "8 ", "08"
Monat = "August"
Case "Sep", "sep", "9", "9 ", "9 ", "09"
Monat = "September"
Case "Okt", "okt", "10", "10 "
Monat = "Oktober"
Case "Nov", "nov", "11", "11 "
Monat = "November"
Case "Dez", "dez", "12", "12 "
Monat = "Dezember"
End Select
m = M1 + Monat + M2
AktuelleMappe = m
AktuellesFenster = Monat
Zuordng(1, 1) = "Arbeitsmittel"
Zuordng(2, 1) = "Computer"
Zuordng(3, 1) = "Unterhalt"
Zuordng(4, 1) = "Haus"
Zuordng(5, 1) = "Ben"
Zuordng(6, 1) = ""
Zuordng(7, 1) = "Kfz"
Zuordng(8, 1) = "Kleidung KR"
Zuordng(9, 1) = ""
Zuordng(10, 1) = "Privat"
Zuordng(11, 1) = ""
Zuordng(12, 1) = "WP"
Zuordng(13, 1) = "Telefon"
Zuordng(14, 1) = "Versicherung"
Zuordng(15, 1) = "Einnahmen"
Zuordng(16, 1) = "Ausgaben"
Windows("Ausgaben " + Jahr + ".xls").Activate
Worksheets(AktuellesFenster).Activate
For i = 1 To 300
Cells(i, 6).Select
If ActiveCell.Value = "Kontrollwert " Then Exit For
Next i
VerticalJahr = i
For i = 2 To 16
LeereGruppen i 'überspringt leere Gruppen
For j = 1 To VerticalJahr
Cells(j, 1).Select
If ActiveCell.Value = Zuordng(i, 1) Then Exit For
EndPosJahrMonat(i - 1 - Korr, 1) = j - 1
Next j
Next i
For i = 2 To 16
LeereGruppen i 'überspringt leere Gruppen
If EndPosJahrMonat(i, 1) <> 0 Then
LenJahrMonat(i, 1) = EndPosJahrMonat(i, 1) - EndPosJahrMonat(i - 1 - Korr, 1) - 2
End If
Next i
LenJahrMonat(1, 1) = EndPosJahrMonat(1, 1) - 4
'Windows(AktuelleMappe).Activate
ActiveWorkbook.Activate
Cells.Select 'selektiert ganzes Blatt
Cells.EntireRow.AutoFit 'optimiert Spaltenbreite
Cells.EntireColumn.AutoFit 'optimiert Zeilenhöhe
For i = 1 To 300
Cells(i, 6).Select
If ActiveCell.Value = "BETRAG Gesamtsumme Summe:" Then Exit For
Next i
Vertical = i
For jj = 1 To 15
kk = 0
For ii = 1 To Vertical
Cells(ii, 2).Select
If Cells(ii, 2).Value = jj Then
For kk = 0 To Vertical
If Cells(ii + kk, 2).Value <> jj Then Exit For
EndPosJahrMonat(jj, 2) = ii + kk
Next kk
ii = ii + kk
End If
Next ii
LenJahrMonat(jj, 2) = kk
Next jj
Windows("Ausgaben " + Jahr + ".xls").Activate
Worksheets(AktuellesFenster).Activate
For i = 15 To 2 Step -1
Diff = 0
'If i = 12 Then i = i - 1 'überspringt leere Gruppen --> 12 wurde für WP verwendet, 11.9.2000
If i = 11 Then i = i - 1
If i = 9 Then i = i - 1
If i = 6 Then i = i - 1
'If i = 5 Then i = i - 1
If LenJahrMonat(i, 1) <= LenJahrMonat(i, 2) Then
Diff = LenJahrMonat(i, 2) - LenJahrMonat(i, 1)
Range(Cells(EndPosJahrMonat(i, 1), 1), Cells(EndPosJahrMonat(i, 1) _
+ Diff, 20)).Select
Selection.EntireRow.Insert
VerticalJahr = VerticalJahr + Diff + 1 'Korrektur der Bearbeitungslänge in"AusgabenXXXX"
Else
If LenJahrMonat(i, 1) > LenJahrMonat(i, 2) + 1 And LenJahrMonat(i, 1) > 2 Then
Diff = LenJahrMonat(i, 1) - LenJahrMonat(i, 2) - 1
Range(Cells(EndPosJahrMonat(i, 1) - Diff, 1), Cells(EndPosJahrMonat(i, 1) - 1, 20)).Select
Selection.EntireRow.Delete
End If
End If
Next i
For i = 2 To 16
LeereGruppen i 'überspringt leere Gruppen
For j = 1 To VerticalJahr
Cells(j, 1).Select
If ActiveCell.Value = Zuordng(i, 1) Then Exit For
EndPosJahrMonat(i - 1 - Korr, 1) = j - 1
Next j
Next i
'Windows(AktuelleMappe).Activate
ActiveWorkbook.Activate
Cells(Vertical + 4, 1).Select
ActiveCell.FormulaR1C1 = "Gruppe"
Cells(Vertical + 4, 2).Select
ActiveCell.FormulaR1C1 = "GrupAnzJahr"
Cells(Vertical + 4, 3).Select
ActiveCell.FormulaR1C1 = "EndPosJahr"
Cells(Vertical + 4, 4).Select
ActiveCell.FormulaR1C1 = "GrupAnzMonat"
Cells(Vertical + 4, 5).Select
ActiveCell.FormulaR1C1 = "EndPosMonat"
Cells(Vertical + 20, 1).Select
ActiveCell.FormulaR1C1 = "BearbLgJahr"
Cells(Vertical + 20, 3).Value = VerticalJahr
For x = 1 To 15
Cells(Vertical + 4 + x, 1).Value = x
Cells(Vertical + 4 + x, 2).Value = LenJahrMonat(x, 1)
Cells(Vertical + 4 + x, 3).Value = EndPosJahrMonat(x, 1)
Cells(Vertical + 4 + x, 4).Value = LenJahrMonat(x, 2)
Cells(Vertical + 4 + x, 5).Value = EndPosJahrMonat(x, 2)
If Cells(Vertical + 4 + x, 2).Value <> Cells(Vertical + 4 + x, 4) Then
'Längenvergleich Gruppen Monat/Jahr
End If
Next x
Range(Cells(Vertical + 4, 1), Cells(Vertical + 25, 5)).Select
Schrift Schriftgroesse, Schriftart
For x = 1 To 15 'kopieren von Monat in Jahr
If LenJahrMonat(x, 2) > 0 Then
'Windows(AktuelleMappe).Activate
ActiveWorkbook.Activate
Range(Cells(EndPosJahrMonat(x, 2) - (LenJahrMonat(x, 2) - 1), 1), _
Cells(EndPosJahrMonat(x, 2), 11)).Select
Selection.Copy
Windows("Ausgaben " + Jahr + ".xls").Activate
Worksheets(AktuellesFenster).Activate
Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2), 1).Select
ActiveSheet.Paste
End If
For i = 0 To LenJahrMonat(x, 2) - 1
Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2) + i, 13).Value = _
Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2) + i, 6).Value * 1.95583
a = Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2) + i, 8).Value
Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2) + i, 8).Value = ""
Cells(EndPosJahrMonat(x, 1) - LenJahrMonat(x, 2) + i, 12).Value = a
Next i
Next x
Windows.Arrange ArrangeStyle:=xlHorizontal
Windows("Ausgaben " + Jahr + ".xls").Activate
Columns("L:Q").Select
'Range("L70").Activate
Selection.NumberFormat = "0.00"
Cells.Select 'selektiert ganzes Blatt
Schrift Schriftgroesse, Schriftart
Cells.EntireRow.AutoFit 'optimiert Spaltenbreite
Cells.EntireColumn.AutoFit 'optimiert Zeilenhöhe
Range("C:C").Select
With Selection 'Ausrichtung rechtsbündig
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
End With
Sheets(Jahr).Select
For i = 2 To 28
For j = 15 To 17
Cells(i, j).Select
If ActiveCell.Value >= 0 Then
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
Selection.Font.ColorIndex = 1
End With
Else
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
Selection.Font.ColorIndex = 2
End With
End If
Next j
Next i
Cells(1, 1).Select 'zeigt ganzes Fenster an
'Windows("Ausgaben 2002.xls").Activate
Reha (Anzeigejahr)
ActiveWorkbook.Save ' "Ausgaben<jjjj>" ist aktiv
Worksheets(AktuellesFenster).Activate
Range("G1").Select
Cells.Find(What:="Kontrollwert", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 1).Activate
WertJahr = ActiveCell.Value
'Windows(AktuelleMappe).Activate
ActiveWorkbook.Activate
'*************************************************************************
a = ""
For i = 1 To 16
Windows("Ausgaben 2015.xls").Activate
'vergl=ausgaben 2015.xls").Activate
Cells(2, i).Select
'vergl=
vergl = Zuordng(i, 1)
Windows("DatumAbfrageAusgabenMärz2015.xls").Activate
For j = 1 To 500
Cells(j, 1).Select
If Cells(j, 1).Value = vergl Then
Windows("Ausgaben 2015.xls").Activate
For k = 1 To 300
Cells(k, 1).Select
If Cells(k, 1).Value = vergl Then
'Column(j + 1, 10).Select
Windows("DatumAbfrageAusgabenMärz2015.xls").Activate
Cells(k, 3).Select
For l = 1 To 30
If Cells(j + l, 3).Value <> "" Then
Cells(j + l, 3).Select
'zaehl = j + l
'a = Right(Cells(j + l, 3), 5)
'If a = "" Then
'If Cells(j + l, 3).Value = " " Then
'If Cells(j + l, 3).Value = False Then
'If Cells(j + l, 3).Formula = " " Then
'If Range(Cells(j + 1, 3)).Value = "" Then
'Cells(1, 3).End(xlDown).Offset(1, 0)
'If Range("d65536").End(xlUp).Offset(1, 0).Value Then
'If (Cells(j + l, 3).Value) Is Null Then
'If istleer(j + l, 3) Then
lRow = Range(Cells(j + 1, 3), Cells(Rows.Count, 1)).Find(What:="").Row
MsgBox "1." & lRow
Stop
'End If
a = ""
zaehl = j + l
Cells(zaehl, 3).Select
'Rows("3:9").Select
End If
Next l
Stop
End If
Next k
Stop
End If
Next j
' For j = 1 To 500
' If Cells(1, j).Value = vegl Then
Windows("DatumAbfrageAusgabenMärz2015.xls").Activate
'Next j
Next i
'Range("G1").Select
' Cells.Find(What:="BETRAG Gesamtsumme Summe:", After:=ActiveCell, LookIn:=xlFormulas, _
' LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
' MatchCase:=False).Activate
' ActiveCell.Offset(0, 1).Activate
' WertMonat = ActiveCell.Value
' If WertJahr = WertMonat Then
' MsgBox ("Auswertung o.K.")
' Else
' MsgBox ("Fehler")
' End If
'Windows("Ausgaben 2004.xls").Activate
'ActiveWorkbook.SaveAs FileName:= _
' "C:\Dokumente und Einstellungen\Charly.KAROMUE\EigeneDateien\Ausgaben 2004.xls" _
' , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
' ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
So. Zufrieden?
|
