Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
628to632
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
628to632
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

verkürzung der VBA-Lösung erwünscht

verkürzung der VBA-Lösung erwünscht
25.06.2005 01:44:24
ilka
Hallo,
nachfolgenden Teil einer Programmierung, insbesondere die Bearbeitung der einzelnen Kostenstellen (siehe unten), möchte ich gern vereinfachen.
Kann mir hierbei jemand helfen ??
Gruß
ILka
'2.Teil daten im tabellenblatt kosten sortieren und übetragen in spalten F unf folgende
Kostenbericht.Activate
' Sortieren der Daten nach Kostenstelle und Konto
Range("A3:C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Filtern der Spalte E nach den Zellen, deren Summe nicht leer ist.'
Selection.AutoFilter Field:=5, Criteria1:="<>"
'Übernehmen der Spalten B und C in die entsprechenden Kostenstellen!'

'Beartbeitung Kostenstelle 1:

Selection.AutoFilter Field:=1, Criteria1:="1"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("F3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 2:

Selection.AutoFilter Field:=1, Criteria1:="2"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("H3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 11:

Selection.AutoFilter Field:=1, Criteria1:="11"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("J3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("K3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 12:

Selection.AutoFilter Field:=1, Criteria1:="12"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("L3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("M3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitng Kostenstelle 21:

Selection.AutoFilter Field:=1, Criteria1:="12"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("O3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 22:

Selection.AutoFilter Field:=1, Criteria1:="22"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("P3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("Q3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Bearbeitung Kostenstelle 31:

Selection.AutoFilter Field:=1, Criteria1:="31"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("R3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("S3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 32:

Selection.AutoFilter Field:=1, Criteria1:="32"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("T3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("U3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 41:

Selection.AutoFilter Field:=1, Criteria1:="41"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("V3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("W3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 51:

Selection.AutoFilter Field:=1, Criteria1:="51"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("X3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("Y3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 60:

Selection.AutoFilter Field:=1, Criteria1:="60"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("Z3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AA3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 61:

Selection.AutoFilter Field:=1, Criteria1:="61"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AB3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AC3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 62:

Selection.AutoFilter Field:=1, Criteria1:="62"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AD3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AE3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Bearbeitung Kostenstelle 63:

Selection.AutoFilter Field:=1, Criteria1:="63"
ActiveWindow.SmallScroll Down:=-15
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AF3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-12
Selection.Copy
Range("AG3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Filter Spalte A und E herausnehmen :

Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=5

End Sub

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
25.06.2005 07:33:54
Hajo_Zi
Hallo ilka,
eine Datei wäre wohl besser gewesen, meiner Meinung nach. Für mich ergeben sich schon Fragen nach den ersten Zeilen.
Warum werden die Spalten nur A bis C ab Zeile 3 sortiert die Tabelle ist doch breiter weil im nächsten Schritt nach Spalte E gefiltert wird.
In VBA kann zu 99% auf select verzichtet werden.
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.



Anzeige
AW: verkürzung der VBA-Lösung erwünscht
25.06.2005 08:30:26
ilka
Hallo hajo,
als basis liegt ja die datei kostenbericht vor, in der der überwiegende teil bereits über excelformeln zusammengefasst und komprimiert wird. was ich gern erreichen möchte, ist, dass die bearbeitung dieser datei noch weniger zeit in anspruch nimmt. da ich im rahmen meines bwl-studiums eh eine vba-lösung programmieren muss, wollte ich zwei fliegen mit einer klappe schlagen. bei notwendigkeit sende ich dir diese datei gern zu.
die spalten d bis f sind mit excelformeln hinterlegt, daher habe ich nur spalte a bis c selektiert. zeilen 1 und 2 sind jeweils mit überschriften belegt, daher ab zeile 3.
gruß
ilka
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
25.06.2005 08:41:23
Hajo_Zi
Hallo ilka,
mir scheint wir kommen bei dem Problem nicht zusammen. Du willst die Datei nicht hochladen und ich sehe kein Grund die Datei nachzubauen. Ich bin ein Mensch der eigentlich seinen Coode testet bevor er ihn postestet, aber Da mußt Du jetzt selber klar kommen mir den Fehlermeldungen und dem Zusammenfassen der Kostenstellen zu einer Schleife.

Sub test()
Dim LoLetzte As Long
'2.Teil daten im tabellenblatt kosten sortieren und übetragen in spalten F unf folgende
With Kostenbericht
' Sortieren der Daten nach Kostenstelle und Konto
'    Range("A3:C3").Select
'    Range(Selection, Selection.End(xlDown)).Select
.Range("A3").Sort Key1:=.Range("A3"), Order1:=xlAscending, Key2:=.Range("B3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Filtern der Spalte E nach den Zellen, deren Summe nicht leer ist.'
.Range("E2").AutoFilter Field:=5, Criteria1:="<>"
'Übernehmen der Spalten B und C in die entsprechenden Kostenstellen!'
'Beartbeitung Kostenstelle 1:
.Range("E2").AutoFilter Field:=1, Criteria1:="1"
LoLetzte = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
.Range(.Cells(3, 2), .Cells(LoLetzte, 2)).Copy
.Range("F3").PasteSpecial Paste:=xlPasteValues
LoLetzte = IIf(IsEmpty(.Range("E65536")), .Range("E65536").End(xlUp).Row, 65536)
.Range(.Cells(3, 2), .Cells(LoLetzte, 2)).Copy
.Range("G3").PasteSpecial Paste:=xlPasteValues
End With
End Sub

Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 00:14:52
Ilka
Hallo Hajo,
warum soll ich dir die datei nicht zur verfügung stellen wollen? da hast du mich wohl missverstanden. ich bin über jede hilfe dankbar.
ein problem ist allerdings, dass die datei kostenbericht über 10 mb gross ist und ich nur max 300 kb als datei einstellen kann. ich habe jetzt einen teil herausgefiltert: tabellenblatt kosten und 2 kostenstellen-tabellenblätter- der aufbau der weiteren kostenstellen-tabellenblätter ist identisch. https://www.herber.de/bbs/user/24192.zip
desweiteren benötigt man noch die datei "kst ausführlich jjjjmm" des aktuellen monats, da hieraus daten per vba übertragen werden.

Die Datei https://www.herber.de/bbs/user/24193.xls wurde aus Datenschutzgründen gelöscht

es wäre nett, wenn du deinen code noch testen kannst und mir bezüglich der schleifenabbildung weiterhilfst.
gruß
ilka

Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 08:06:32
Hajo_Zi
Hallo Ilka,
das waren mir nun doch zu viele Daten die da kopiert werden. Ich habe jetzt mal den Code bereinigt und alle select entfernt und auch schon einige Sachen umgeschrieben. Um die Schleife habe ich mich erstmal nicht gekümmert. Du solltest Deine Tabelle "Kosten " den Namen "Kosten" geben, also ohne Leerstellen am Ende. Prüfe mal ob der Code noch korrekt läuft, dann nehme ich den nähsten Schritt in Angriff. Ich vermute mal 50% des Codes kann noch eingespart werden.
https://www.herber.de/bbs/user/24195.zip

Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 08:27:49
Hajo_Zi
Hallo Ilka,
ändere das Ende des Codes wie folgt.

'Übernehmen der Spalten B und C in die entsprechenden Kostenstellen!'
Dim InKostenstelle As Integer
Dim InSpalte As Integer         ' BeginnSpalte
InSpalte = 6
For InKostenstelle = 1 To 63
'Beartbeitung Kostenstelle
Range("A2").AutoFilter Field:=1, Criteria1:=InKostenstelle
LoLetzte = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row, 65536)
Range("B3:B" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
InSpalte = InSpalte + 1
LoLetzte = IIf(IsEmpty(Range("E65536")), Range("E65536").End(xlUp).Row, 65536)
Range("E3:E" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
Select Case InKostenstelle
Case 2
InKostenstelle = 10
Case 12
InKostenstelle = 20
Case 22
InKostenstelle = 30
Case 32
InKostenstelle = 40
Case 41
InKostenstelle = 50
Case 51
InKostenstelle = 59
End Select
Next InKostenstelle
'   Filter Spalte A und E herausnehmen :
Range("A2").AutoFilter Field:=1
Range("E2").AutoFilter Field:=5

Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 12:23:41
Ilka
Hallo Hajo,
habe deine letzte Nachricht soeben erst gelesen. wird sofort eingearbeitet. rueckmeldung folgt.
ilka
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 12:26:48
Hajo_Zi
Hallo Ilka,
da Du es jetzt testen willst gehe ich ma davon aus das der Beitrag jetzt nicht offen ist. Ich entferne mal diesen Status mit diesem Beitrag.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 12:47:11
Ilka
Hallo Hajo,
och habe das codeende entsprechend geändert, das ergebnis ist dann jedoch nicht korrekt.
zum einen kann es sein, dass, sofern zu einer kostenstelle keine daten vorliegen (hier in kostenstelle 2), die daten der nächsten kostenstelle in der vorherigen kostenstelle landen. und zweitens stimmen die danach folgenden dateneinträge leider auch nicht. das erkennt man daran, dass die anzahl der gefüllten zeilen zu konto und betrag für eine kostenstelle identisch sein müssen, was hier jedoch nicht der fall ist.
was bedeuten die anweisungen InKostenstelle = 10 , 20, ...??
gruß
ilka
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 12:53:02
Hajo_Zi
Hallo Ilka,


            Case 2

                InKostenstelle = 10

nach Kostenstelle 2 soll als nächstes die Kostenstel´le 11 bearbeitet werden bei Next wird die Variable um 1 erhöht und damit wird als nächstes Kostenstelle 11 bearbeitet.
Du hast Deine Datei verändert. Damit ist meine Datei nicht mehr aktuell. Lade die neue nochmal hoch.
Dein Fehler ist mir zur Zeit nicht nachvollziehbar.
Was hast Du am Code geändert? markiere es mal.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 14:09:45
Hajo_Zi
Hallo Ilka,
ändere den Code wie folgt.

Private Sub Kostenberichterstellen_Click()
Dim StAblage As String
Dim jjjjmm As String
'   Ablage Hajo
StAblage = "D:\Eigene Dateien\Hajo\Internet\Test\"
'   Ablage Ilka
'    StAblage = "C:\Dokumente und Einstellungen\addy\Desktop\DVR1\TFH Wildau\AngewInformatik\"
'Eingabe auslesen in Variablen speichern
jjjjmm = Monat.Text
' sicherstellen, dass Eingabefelder nicht leer oder keine Zahl eingegeben
If jjjjmm = "" Or IsNumeric(jjjjmm) = False Or jjjjmm > 200512 Or jjjjmm < 200501 Then
MsgBox "Bitte Monat in korrekter Zahlenform eingeben, z.B. Mai 2005 als 200505"
Exit Sub
End If
'Bearbeiter kann jetzt wählen zwischen Kostenberichterstellen und abbrechen
'Fall 1 : Wahl = Abbrechen siehe Private Sub AbbrechenKostenbericht_Click()
'fall 2 : wahl = kostenbericht erstellen
'1.teil : datenübertragung von basisdatei in kostenbericht
'öffnen datei Kst ausführlich, in Anhängigkeit von dem gewünschten Monat
'zusätzlich bei Fehlermeldung (z.B. Datei ist nicht auffindbar) Msg-Box mit
'Fehler anzeigen und über OK-Button die Userform sowie die Arbeitsmappe schliessen lassen
'   ***** Dieser Vergleich ist sinnlos das wurde schon im ersten Vergleich geprüft
'    If jjjjmm <> "" And IsNumeric(jjjjmm) = True Then
'Bei Fehlermeldung (z.B. Datei ist nicht auffindbar) Msg-Box mit Fehler anzeigen
'und über OK-Button die Userform sowie die Arbeitsmappe schliessen lassen
'   Prüfen ob Ordner vorhanden
'   von Berti Koern
Dim Fso, Ordnername
Set Fso = CreateObject("Scripting.FileSystemObject")
'    MsgBox Fso.FolderExists(Ordnername)
If Fso.FolderExists(StAblage) = False Then
MsgBox "Ordner nicht vorhanden"
Unload MOnatsabfrage
'Mappe schliessen
Kostenbericht.Close
'   man könnte auf das Exit Sub verzichten wenn man hinter Close True oder False
'   schreibt, gerade ob speichern oder nicht
Exit Sub
End If
'   Prüfen ob Datei vorhanden
'   auf ein Prüfung ob die Datei schon offen ist wurde verzichtet
'   von Berti Koern
Dim Dateiname
Set Fso = CreateObject("Scripting.FileSystemObject")
Dateiname = StAblage & "Kst ausführlich " & jjjjmm & ".xls"
If Fso.FileExists(Dateiname) Then
Workbooks.Open Dateiname
Else
MsgBox "Datei nicht vorhanden"
Unload MOnatsabfrage
'Mappe schliessen
Kostenbericht.Close
'   man könnte auf das Exit Sub verzichten wenn man hinter Close True oder False
'   schreibt, gerade ob speichern oder nicht
Exit Sub
End If
'Userform Monatsabfrage ausblenden, Spalte hinter Spalte H in "Kst ausführlich" einfügen,
' Formel einfügen ab Zeile 2 = Wert Spalte H * -1 (Zeile 2 bis 6000),
MOnatsabfrage.Hide
'   Dieser Befehl braucht nicht sein da die letzte geöffnete Datei die aktive ist
'    Windows("Kst ausführlich " & jjjjmm & ".xls").Activate
Columns("I:I").Insert Shift:=xlToRight
With Range("I2")
.FormulaR1C1 = "=RC[-1]*-1"
.AutoFill Destination:=Range("I2:I6000"), Type:=xlFillDefault
'in Datei Kst ausführlich Filter setzen : Sollkonto=nichtleer, Spalten A,G und I
'ab Zeile 2 bis zur letzten gefüllten Zeile kopieren, Werte einfügen in Datei Kostenbericht
End With
Range("G1").AutoFilter Field:=7, Criteria1:="<>"
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
Range("A2:A" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range("A3").PasteSpecial Paste:=xlPasteValues
End With
LoLetzte = IIf(IsEmpty(Range("G65536")), Range("G65536").End(xlUp).Row, 65536)
Range("G2:G" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range("B3").PasteSpecial Paste:=xlPasteValues
End With
LoLetzte = IIf(IsEmpty(Range("I65536")), Range("I65536").End(xlUp).Row, 65536)
Range("I2:I" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range("C3").PasteSpecial Paste:=xlPasteValues
End With
'in Datei Kst ausführlich Filter setzen: Filter Sollkonto raus, Filter
' Habenkonto = nichtleer, Spalten A, J und K kopieren, Werte einfügen in Kostenbericht
' zweiter Durchlauf
Range("G1").AutoFilter Field:=7
Range("J1").AutoFilter Field:=10, Criteria1:="<>"
LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
Range("A2:A" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range(.Range("A:A").Find("").Address).PasteSpecial Paste:=xlPasteValues
End With
LoLetzte = IIf(IsEmpty(Range("J65536")), Range("J65536").End(xlUp).Row, 65536)
Range("J2:J" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range(.Range("B:B").Find("").Address).PasteSpecial Paste:=xlPasteValues
End With
LoLetzte = IIf(IsEmpty(Range("K65536")), Range("K65536").End(xlUp).Row, 65536)
Range("K2:K" & LoLetzte).Copy
With Workbooks("Kostenbericht.xls").Worksheets("Kosten")
.Range(.Range("C:C").Find("").Address).PasteSpecial Paste:=xlPasteValues
End With
'Datei Kst ausführlich schliessen
'   **** hier fehlt True oder False es kommt jetzt noch die Abfrage ob gespeichert
'   Zwischenspeicher löschen
Application.CutCopyMode = False
Windows("Kst ausführlich " & jjjjmm & ".xls").Close
'2.Teil daten im tabellenblatt kosten sortieren und übetragen in spalten F unf folgende
'   dieser Befehl braucht nicht sein da nach schliessen de anderen Datei diese so und so aktiv ist
'    Kostenbericht.Activate
' Sortieren der Daten nach Kostenstelle und Konto
Range("A3").Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Filtern der Spalte E nach den Zellen, deren Summe nicht leer ist.'
Range("F3").AutoFilter Field:=5, Criteria1:="<>"
'Übernehmen der Spalten B und C in die entsprechenden Kostenstellen!'
Dim InKostenstelle As Integer
Dim InSpalte As Integer         ' BeginnSpalte
InSpalte = 6
For InKostenstelle = 1 To 63
'Beartbeitung Kostenstelle
Range("A2").AutoFilter Field:=1, Criteria1:=InKostenstelle
LoLetzte = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row, 65536)
If LoLetzte > 2 Then
Range("B3:B" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
InSpalte = InSpalte + 1
LoLetzte = IIf(IsEmpty(Range("E65536")), Range("E65536").End(xlUp).Row, 65536)
Range("E3:E" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
InSpalte = InSpalte + 1
Else
InSpalte = InSpalte + 2
End If
Select Case InKostenstelle
Case 2
InKostenstelle = 10
Case 12
InKostenstelle = 20
Case 22
InKostenstelle = 30
Case 32
InKostenstelle = 40
Case 41
InKostenstelle = 50
Case 51
InKostenstelle = 59
End Select
Next InKostenstelle
'   Filter Spalte A und E herausnehmen :
Range("A3").AutoFilter Field:=1
Range("E2").AutoFilter Field:=5
End Sub

Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 14:21:20
Hajo_Zi
Hallo Ilka,
hier noch eine Veränderung am Schluss

'Übernehmen der Spalten B und C in die entsprechenden Kostenstellen!'
Dim InKostenstelle As Integer
Dim InWert As Integer
Dim InSpalte As Integer         ' BeginnSpalte
InSpalte = 6
For InKostenstelle = 1 To 63
InWert = Mid(Cells(1, InSpalte), InStr(Cells(1, InSpalte), "stelle") + 6, 2)
'Beartbeitung Kostenstelle
Range("A2").AutoFilter Field:=1, Criteria1:=InWert
LoLetzte = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row, 65536)
If LoLetzte > 2 Then
Range("B3:B" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
InSpalte = InSpalte + 1
LoLetzte = IIf(IsEmpty(Range("E65536")), Range("E65536").End(xlUp).Row, 65536)
Range("E3:E" & LoLetzte).Copy
Cells(3, InSpalte).PasteSpecial Paste:=xlPasteValues
InSpalte = InSpalte + 1
Else
InSpalte = InSpalte + 2
End If
Next InKostenstelle
'   Filter Spalte A und E herausnehmen :
Range("A3").AutoFilter Field:=1
Range("E2").AutoFilter Field:=5

Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 18:38:37
Ilka
hallo hajo,
ich habe deine letzte änderung nun eingefügt. die anweisungen werden korrekt ausgeführt, bis die daten zur letzten kostenstelle gefüllt sind. die inhalte sind jetzt auch alle korrekt. jedoch erscheint dann (vor herausnahme der filter spalte a und e) die meldung laufzeitfehler 13, typen unverträglich. die zeile "InWert = Mid(Cells(1, InSpalte), InStr(Cells(1, InSpalte), "stelle") + 6, 2)" wird dann markiert. warum erscheint die meldung, kannst du den fehler beheben ?
anbei die aktualisierte datei:
https://www.herber.de/bbs/user/24203.zip
zu deiner frage, was ich geändert habe:
ich habe einige bemerkungen herausgenommen, hinter "close" jeweils true bzw. false ergänzt (wie vorgeschlagen), deine nachträglichen änderungen eingefügt sowie die ablage ilka "aktiviert". ursprünglich hatte ich zur kostenstelle 12 den code verbessert (angepasst an die anderen kostenstellen), das hat sich jedoch nun erledigt durch deine änderung des letzten teils.
gruß
ilka
und danke für deine hilfe !!
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 19:02:13
Hajo_Zi
Hallo Ilka,
ich habe folgende Veränderungen vorgenommen:
- den von Dir angesprochenen Teil verändert
- die Dateigröße veringert auf ca. 50%
- den Bildschirm abgeschaltet während der Makroausführung
- Startmakro eingefügt
- alle Variablendefinitionen zu Beginn der Prozedur
- einige Variablen entfernt
https://www.herber.de/bbs/user/24204.zip
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 22:54:22
Ilka
hallo hajo,
der code funktioniert super - vielen dank.
vielleicht kannst du mir ja auch bei folgendem problem helfen :
betrifft gleiche datei, hier die aktualisierte version:
https://www.herber.de/bbs/user/24208.zip
als nachfolgenden schritt sind in den folgenden tabellenblättern ("1","2",...) in der spalte des aktuellen monats jeweils die beträge zu den entsprechenden konten einzufügen. dies habe ich bisher über sverweise manuell vorgenommen. ich möchte die übertragung gern in den bereits bestehenden vba-code einbinden.
die manuellen schritte pro tabellenblatt (= pro kostenstelle) sehen wie folgt aus:
1. in der spalte des aktuellen monats mm ist in allen zeilen, wo in spalte 3 ein zahleneintrag vorhanden ist, folgender sverweis einzufügen: sverweis (gleiche zeile spalte3, matrix aus tabellenblatt kosten besthend aus spalten konto und betrag der jeweiligen kostenstelle, 2, falsch)
2. alle vervollständigten zellen kopieren und inhalte einfügen - nur werte
3. alle einträge #nv ersetzen durch ""
gruß
ilka
AW: verkürzung der VBA-Lösung erwünscht
27.06.2005 05:50:46
Hajo_Zi
Hallo ilka,
ich habe mir das nun noch nicht angesehen. Aber aus der Erfahrung vom ersten Teil ist mir schon klar das dies auch eine intensive Betreuung bedarf. Dafür habe ich in der Woche wenig Zeit.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
27.06.2005 20:08:42
Hajo_Zi
Hallo ilka,
ich habe mir die Datei schon mal angesehen und schon einige Zeilen Code nachgeschrieben.
https://www.herber.de/bbs/user/24255.zip
Die Tabelle "1" habe ich mir schom angesehen, aber keinen Sverweis gefunden.
Mir ist nur schon aufgefallen in Tabelle "Kosten" gibt es einige "Konten" die in Tabelle "1" nicht als "Kostenart" erscheint. Warum zwei unterschiedliche Begriffe?
Ich vermute mal der Sverweis ist weil die Daten in Kosten stehen. Es ist doch einen einfache Prozedur nach der erstenn in den Kosten die Spalten für den Monat durch Werte zu ersetzen.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
27.06.2005 22:55:06
Ilka
hallo hajo,
den sverweis habe ich bisher jeweils bei der berichtserstellung manuell geschrieben und dann in die betreffenden zeilen kopiert. wenn ich in allen spalten die sverweise einfüge und nach berichtserstellung die formeln nicht eliminiere, würden bei der erstellung des berichts für den folgemonat automatisch die spalten der anderen monate auch mit den daten des aktuellen monats gefüllt werden, da die matrix (konto und betrag) jeweils aktualisiert wird.
ich habe dir mal die sverweise in excel für die spalte mai exemplarisch eingefügt:
https://www.herber.de/bbs/user/24257.zip
die konten stammen aus dem buchhaltungssystem, nur ein teil der konten stellen jedoch kostenarten dar. in tabelle 1 sind alle kostenarten , nicht jedoch alle konten zu finden. die im tabellenblatt 1 aufgeführten kostenarten sind jedoch gleichzusetzen mit dem gleichnamigen konto. ich benötige den sverweis, da ich die beträge nicht von allen, sondern nur von bestimmten konten (=kostenarten) übertrage. mittels sverweis wird die erste spalte der matrix (hier konto) nach dem suchkriterium (hier kostenart) durchsucht. wird das suchkriterium gefunden, wird die gleiche zeile der matrix nach rechts durchlaufen, um dann den wert einer zelle (hier betrag) zurückzugeben. der spaltenindex 2 besagt, dass der zellwert der 2.spalte der matrix (hier betrag) zurückzugeben ist. wenn ich ohne sverweise alle zugehörigen werte manuell suchen und kopieren würde, dann würde der aufwand um ein vielfaches steigen.
ich weiss nicht genau, ob solch ein sverweis auch über vba lösbar ist.
ich denke, 2. und 3. kann ich auch allein bewältigen, problematisch wird es nur, weil ich die zwischensummen (in tabellenblatt 1 gelb hinterlegt) so beibehalten möchte. dort dürfen die formeln nicht eliminiert werden. ich muss also genaue zeilenangaben von... bis... einbauen, für die das kopieren/werte einfügen sowie das eliminieren von #nv stattfinden soll.
ich stehe dir für weitere rückfragen gern zur verfügung.
gruß
ilka
AW: verkürzung der VBA-Lösung erwünscht
28.06.2005 05:49:12
Hajo_Zi
Hallo ilka,
die Datei habe ich noch nicht runtergeladen. Aber bisher bin ich davon ausgegangen das alle Formeln einer Spalte (Monat) durch Werte ersetzt werden sollen. Warum die Zwischensummen nicht ersetzt werden soll ist mir nich klar. Werden die Werte noch von Hand korrigiert? Ich vermute mal es kann sein das jemand die Monatsabrechnung startet, die Formel werden ersetzt und irgendwann wird die gleiche Monatsabrechnung nochmal gestartet und die Werte werden nicht mehr eingetragen, da die Formeln nicht mehr vorhanden sind?
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
28.06.2005 10:16:03
Ilka
hallo hajo,
es finden öfters nachbuchungen für bereits abgeschlossene monate statt. sind es nur wenige nachbuchungen, trage ich die veränderungen manuell nach. sind es viele nachbuchungen, veranlasse ich die berichterstellung der betreffenden monate neu.
die zwischensummen müssen jeweils aktuell sein, da diese verknüpft sind mit weiteren tabellenblättern (welche aus kapazitätsgründen hier gelöscht wurden). ich denke, wenn die summenformeln eliminiert werden, wäre das eine mögliche fehlerquelle in der berichterstattung.
gruß
ilka
AW: verkürzung der VBA-Lösung erwünscht
28.06.2005 10:33:30
Hajo_Zi
Hallo Ilka,
jetzt haben wir den Umfang geklärt. Meine Einschätzung die Werte für die Kostenarten? müssen einzeln per VBA Programm übertragen werden. Sverweis geht nicht, da ja im nächsten Monat dann die falschen Werte in der Tabelle stehen. Formel durch Werte ersetzen scheidet auch aus da hiermit Nachbuchungen bzw. erneuter Lauf nicht die Werte eingetragen werden.
So wie ich das sehe ist das über zwei Schleifen in Verbindung mit Find lösbar, aber der Zeitaufwand erscheint mir einfach zu hoch.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
29.06.2005 08:33:19
Ilka
hallo hajo,
stecke gerade im prüfungsstress und habe deshalb sehr wenig zeit. ich werde mich am samstag nach meinen prüfungen ransetzen und den code zunächst selbst schreiben, soweit ich das kann. dann ist für dich auch einfacher nachzuvollziehen, wie die die lösung aussehen soll. meines erachtens ist ein sverweis einsetzbar, das wirst du dann in der vorgefertigten lösung sehen können. ich werde wieder das problem haben, dass die lösung im groben zwar vorhanden ist, aber dies nicht der kürzeste weg sein wird. ich hoffe du kanst mir dann helfen, den code fachmännich zu vereinfachen und zu verkürzen.
bis samstag
gruß
ilka

AW: verkürzung der VBA-Lösung erwünscht
29.06.2005 08:52:00
Hajo_Zi
Hallo Ilka,
zur Zeit habe ich an meinen Homecomputer keine Zugang zum Internet. Ich hoffe aber das sich das Problem bald löst.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
AW: verkürzung der VBA-Lösung erwünscht
26.06.2005 12:21:26
Ilka
hallo hajo,
der code läuft jetzt korrekt, bei Kostenstelle 12 war noch ein kleiner fehler, in der exceltabelle selbst war auch noch ein fehler in den formeln, beides ist nun bereinigt, die anwendung läuft super.
den code hätte ich als anfänger niemals so hinbekommen. schon mal danke hierfür.
die datei benenne ich noch um.
du kannst gern den nächsten schritt in angriff nehmen - ich freue mich schon drauf.
https://www.herber.de/bbs/user/24197.zip

gruß
ilka

300 Forumthreads zu ähnlichen Themen

@Hans W. Herber: 1 Million Beiträge - Glückwunsch
mpb

Hallo Hans,
wenn ich die URLs richtig interpretiere, haben wir im Forum soeben die Zahl von 1 Million Beiträgen überschritten.
Herzlichen Glückwunsch zu dem Erfolg Deines "Babys"!
Gruß
Martin
07.08.2008 16:23:47
Thread-ID: 1000004
3 Beiträge
Anzeige
Frage - Spalten einfügen & Spalten untereinander z
André

Hallo zusammen!
Ich habe da als blutiger Anfänger in VBA zwei Fragen:
1.) Wie kann ich in meiner Tabelle in jeder zweiten Spalte 4 leere Spalten einfügen lassen?
2.) Dann möchte ich unter den Inhalt der ersten fünf Spalten (A-E) den Inhalt der zweiten 5 Spalten (F-J) usw. In der grö...
08.08.2008 16:00:00
Thread-ID: 1000340
3 Beiträge
Zellen mit Werten aus darüberliegender Zelle fülle
Andreas

Guten Morgen!
Ich hätte folgendes Problem: Ich erhalte automatisiert Exceltabellen, bei denen nicht alle Zellen einer Zeile gefüllt werden, wenn dort der Inhalt einer darüberliegenden Zeile stehen sollte. Zur Weiterverarbeitung muss ich aber diese Zellen mit den dazugehörigen Werten füllen....
11.08.2008 08:59:25
Thread-ID: 1000713
4 Beiträge
Anzeige
Zellen formatieren mit vorangehenden "Nullen"
Addi

Hallo zusammen,
ich habe eine lange Liste, in der in einer Spalte Daten stehen, wo ab und zu vorangehende Nullen nötig sind (mal eine - mal 2...etc.) - und manchmal auch keine.
Wie kann ich diese Zellen formatieren, das die vorangehenden "Nullen" nicht automatisch weggelassen werden?
11.08.2008 10:37:00
Thread-ID: 1000746
8 Beiträge
Makro beenden bei Option "Schliessen"
Jürgen

Hallo Excel-Profis
ich habe folgenden Code in ein Makro eingebaut:
'Drucken mit Vorschau
Application.ActivePrinter = "\\dataserv\HP LaserJet 5L AV auf Ne05:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:= _
True
Hier wird der Standard-Drucker an...
11.08.2008 12:39:00
Thread-ID: 1000811
9 Beiträge
Zellen prüfen / Ausgabe wenn Bedingung erfüllt
Kay

Hallo,
Ich brauche dringend Eure Hilfe. Unter https://www.herber.de/bbs/user/54533.xls findet Ihr eine Mappe, in welcher in Spalte A
1 für "Kaufen"
0 für " "
-1 für "Verkaufen"
steht. IN SPALTE B SIND BISHER NUR MANUELL ERSTELLTE BEISPIELEINTRÄGE ENTHALTEN, DAMIT ERSICHTLIC...
12.08.2008 09:51:36
Thread-ID: 1001078
3 Beiträge
"Bild von Excel-Kamara" variabel...
Excel-Kamara"

Hi Experten,
einen Bereich (Zellen, Bild, Grafik...) mit der Excel-Kamara "fotografieren" und in eine andere Excelmappe einfügen ist kein Problem.
Bei mir werden Ecxel_Vorlagen ausgefüllt und unter fortlaufender Dateinummer abgespeichert, zB. QR000123, QR000124, QR000125 usw. Alle Datei...
12.08.2008 10:33:28
Thread-ID: 1001116
4 Beiträge
Formel "Text" ROTE Zahl bei Minuswert?
dieter(drummer)

Hi Formelspezialisten,
in Zelle B2 steht dise Formel (funktionert auc h):
=TEXT(I4-D4;"00.0")&" ("&TEXT(I4/D4-1;"0%")&")".
Mein Ziel, dass eine Minuszahl in ROT erscheint. Hab's mit bedingte Formatierung versucht und bekomme es nicht hin.
Gibt es eine Möglichkeit, a...
12.08.2008 10:59:29
Thread-ID: 1001135
7 Beiträge

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
2
7
2
3
1
7
8
2
3
6
11
5
5
8
15
3
7
4
4
3
2
7
4
3
4