Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
444to448
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
444to448
444to448
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Performance Steigerung meines VBA Codes

Performance Steigerung meines VBA Codes
27.06.2004 04:17:27
Y. Housein
Hallo zusammen,
Sorry, das ich einen neuen Beitrag eröffnen habe. Aber langsam drehe ich am Rad. Mein Ziel ist es den folgenden VBA Code schneller zu machen. Ich habe schon gehört und gelesen, das ich auf select verzichten soll. Diese Ratschläge habe ich auch versucht umzusetzen, leider ohne großen Erfolg. Anbei mein Code:

Sub InbestimmtenOrdnerspeicher()
'VBA bzw. Makroausführung im Hintergrund
Application.ScreenUpdating = False
' Rechnung im Rechnungsjournal buchen
' hier wird in der Zeile 50 und Spalte 5 nach Zelle geschaut, wenn es leer ist dann wird der Prozedur einfach beendet
If Sheets("Rechnung").Cells(70, 12) = 0 Then
MsgBox ("Sie haben keine Artikel ausgewählt. Bitte gewünschte Artikel eigeben!")
Exit Sub
End If
' Arbeitsmappen werden ungeschützt geöffnet
ActiveSheet.Unprotect ("test")
Worksheets("Kunden").Visible = True
Worksheets("Forderungen").Visible = True
Worksheets("Einnahmen Übersicht").Visible = True
Worksheets("Journal Gutschrift Übersicht").Visible = True
Worksheets("Personal").Visible = True
Worksheets("Artikel").Visible = True
Worksheets("Kundenpreise").Visible = True
Worksheets("Infos f YH").Visible = True
Worksheets("Journal").Visible = True
Worksheets("Lieferart").Visible = True
Worksheets("Verkaufte Artikel").Visible = True
Worksheets("Verkaufte Artikel-Normal").Visible = True
Worksheets("Pfand Kosten").Visible = True
Sheets("ST Verkaufte Artikel Gesamt").Visible = True
Sheets("ST Pfand Kosten").Visible = True
Worksheets("Gutschrift").Visible = True
Worksheets("Journal Gutschrift").Visible = True
'Arbeitsmappe Rechnung wird ausgewählt
Sheets("Rechnung").Select
[j19] = [j19] + 1
Cells(18, 10).Value = Format(Date, "dd.mm.yy")
Dim sPath As String
Dim Speicherpfad As String
Dim SpeicherpfadDatei As String
Dim Kundenname As String
Kundenname = Range("E18").Value
SpeicherpfadDatei = Range("e4").Value
Speicherpfad = Range("j15").Value
dat = Range("J18").Value
sPath = "D:\Touren\Faktura\" & Speicherpfad & "\"
On Error Resume Next
MkDir sPath & Year(dat)
sPath = sPath & Year(dat) & "\"
MkDir sPath & Kundenname
sPath = sPath & Kundenname & "\"
MkDir sPath & Format(dat, "mm yyyy")
sPath = sPath & Format(dat, "mm yyyy") & "\"
ActiveSheet.Copy
ActiveWorkbook.SaveAs sPath & _
Range("j19").Value & " " & Range("J15") & " " & Range("E18") & _
" " & Format(dat, " dd-mm-yyyy") & ".xls"
ActiveWorkbook.Close
For x = 26 To 55
'1. Range("E" & x).Select
'1. Artikelname$ = ActiveCell.Value
Artikelname$ = Range("E" & x).Value '1. wurde ersetzt
'2. Range("d" & x).Select
'2. Menge = ActiveCell.Value
Menge$ = Range("D" & x).Value '2. wurde ersetzt
'Range("E" & x).Select
Sheets("artikel").Select
Range("B9").Select
'vermeide das ganze "hin-und her-"selektieren.
'   Ersetze z.B.
'   Range("E" & x).Select
'   Artikelname$ = ActiveCell.Value
'   durch
'   Artikelname$ = Range("E" & x).Value
For a = 10 To ActiveCell.SpecialCells(xlLastCell).Row + 1
'Range("B" & A).Select
Artikelname1$ = ActiveCell.Value
Range("B" & a).Select
If Artikelname1$ = Artikelname$ Then
Range("H" & a).Select
Bestand = Range("H" & a).Value - Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next a
Sheets("Rechnung").Select
Range("E" & x).Select
Next x
For y = 64 To 69
'Range("E" & y).Select
'Artikelname$ = ActiveCell.Value
Artikelname$ = ActiveCell.Value
Range("E" & x).Select
'Range("d" & y).Select
Menge = Range("d" & y).Value
Range("E" & y).Select
Sheets("artikel").Select
Range("B9").Select
For B = 11 To ActiveCell.SpecialCells(xlLastCell).Row + 1
Range("B" & B).Select
Artikelname1$ = ActiveCell.Value
If Artikelname1$ = Artikelname$ Then
Range("K" & B).Select
Bestand = ActiveCell.Value + Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next B
Sheets("Rechnung").Select
Range("E" & x).Select
Next y
Sheets("Journal").Select   'Übertragung v. Rechnung nach Journal
Range("A:A").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5)       ' Kunden Name
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Rechnung").Cells(19, 10) ' RechngNr
ActiveCell.Offset(0, 5) = Sheets("Rechnung").Cells(18, 10) ' RechndDatum
ActiveCell.Offset(0, 6) = Sheets("Rechnung").Cells(61, 5) 'MWSt 7%
ActiveCell.Offset(0, 7) = Sheets("Rechnung").Cells(61, 7) ' MWSt 16%
ActiveCell.Offset(0, 8) = Sheets("Rechnung").Cells(61, 10) 'MWSt Gesamt
ActiveCell.Offset(0, 9) = Sheets("Rechnung").Cells(70, 12) 'Zahlbetrag
ActiveCell.Offset(0, 10) = Sheets("Rechnung").Cells(64, 11) 'Bezahle Betrag
ActiveCell.Offset(0, 11) = Sheets("Rechnung").Cells(65, 11) 'Offene Betrag
ActiveCell.Offset(0, 12) = Sheets("Rechnung").Cells(62, 12) 'Pfand Bezahlt
ActiveCell.Offset(0, 13) = Sheets("Rechnung").Cells(70, 10) 'Pfand Rückgabe
ActiveCell.Offset(0, 14) = Sheets("Rechnung").Cells(64, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 15) = Sheets("Rechnung").Cells(64, 5) 'Pfand Artikel
ActiveCell.Offset(0, 16) = Sheets("Rechnung").Cells(65, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 17) = Sheets("Rechnung").Cells(65, 5) 'Pfand Artikel
ActiveCell.Offset(0, 18) = Sheets("Rechnung").Cells(66, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 19) = Sheets("Rechnung").Cells(66, 5) 'Pfand Artikel
ActiveCell.Offset(0, 20) = Sheets("Rechnung").Cells(67, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 21) = Sheets("Rechnung").Cells(67, 5) 'Pfand Artikel
ActiveCell.Offset(0, 22) = Sheets("Rechnung").Cells(68, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 23) = Sheets("Rechnung").Cells(68, 5) 'Pfand Artikel
ActiveCell.Offset(0, 24) = Sheets("Rechnung").Cells(69, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 25) = Sheets("Rechnung").Cells(69, 5) 'Pfand Artikel
Sheets("Verkaufte Artikel-Normal").Select 'Übertragung v. Rechnung n. Verk. Artikel
ActiveSheet.Unprotect ("test")
Range("A:A").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5)       ' Kundenname
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Rechnung").Cells(19, 10) ' RechndNr
ActiveCell.Offset(0, 5) = Sheets("Rechnung").Cells(18, 10) ' RechngDatum
ActiveCell.Offset(0, 6) = Sheets("Rechnung").Cells(26, 4) 'Anzahl
ActiveCell.Offset(0, 7) = Sheets("Rechnung").Cells(26, 5) 'Beschreibung
ActiveCell.Offset(0, 8) = Sheets("Rechnung").Cells(27, 4) 'Anzahl
ActiveCell.Offset(0, 9) = Sheets("Rechnung").Cells(27, 5) 'Beschreibung
ActiveCell.Offset(0, 10) = Sheets("Rechnung").Cells(28, 4) 'Anzal
ActiveCell.Offset(0, 11) = Sheets("Rechnung").Cells(28, 5) 'Beschreibung
ActiveCell.Offset(0, 12) = Sheets("Rechnung").Cells(29, 4) 'Anzal
ActiveCell.Offset(0, 13) = Sheets("Rechnung").Cells(29, 5) 'Beschreibung
ActiveCell.Offset(0, 14) = Sheets("Rechnung").Cells(30, 4) 'Anzal
ActiveCell.Offset(0, 15) = Sheets("Rechnung").Cells(30, 5) 'Beschreibung
ActiveCell.Offset(0, 16) = Sheets("Rechnung").Cells(31, 4) 'Anzal
ActiveCell.Offset(0, 17) = Sheets("Rechnung").Cells(31, 5) 'Beschreibung
ActiveCell.Offset(0, 18) = Sheets("Rechnung").Cells(32, 4) 'Anzal
ActiveCell.Offset(0, 19) = Sheets("Rechnung").Cells(32, 5) 'Beschreibung
ActiveCell.Offset(0, 20) = Sheets("Rechnung").Cells(33, 4) 'Anzal
ActiveCell.Offset(0, 21) = Sheets("Rechnung").Cells(33, 5) 'Beschreibung
ActiveCell.Offset(0, 22) = Sheets("Rechnung").Cells(34, 4) 'Anzal
ActiveCell.Offset(0, 23) = Sheets("Rechnung").Cells(34, 5) 'Beschreibung
ActiveCell.Offset(0, 24) = Sheets("Rechnung").Cells(35, 4) 'Anzal
ActiveCell.Offset(0, 25) = Sheets("Rechnung").Cells(35, 5) 'Beschreibung
ActiveCell.Offset(0, 26) = Sheets("Rechnung").Cells(36, 4) 'Anzal
ActiveCell.Offset(0, 27) = Sheets("Rechnung").Cells(36, 5) 'Beschreibung
ActiveCell.Offset(0, 28) = Sheets("Rechnung").Cells(37, 4) 'Anzal
ActiveCell.Offset(0, 29) = Sheets("Rechnung").Cells(37, 5) 'Beschreibung
ActiveCell.Offset(0, 30) = Sheets("Rechnung").Cells(38, 4) 'Anzal
ActiveCell.Offset(0, 31) = Sheets("Rechnung").Cells(38, 5) 'Beschreibung
ActiveCell.Offset(0, 32) = Sheets("Rechnung").Cells(39, 4) 'Anzal
ActiveCell.Offset(0, 33) = Sheets("Rechnung").Cells(39, 5) 'Beschreibung
ActiveCell.Offset(0, 34) = Sheets("Rechnung").Cells(40, 4) 'Anzal
ActiveCell.Offset(0, 35) = Sheets("Rechnung").Cells(40, 5) 'Beschreibung
ActiveCell.Offset(0, 36) = Sheets("Rechnung").Cells(41, 4) 'Anzal
ActiveCell.Offset(0, 37) = Sheets("Rechnung").Cells(41, 5) 'Besch
ActiveCell.Offset(0, 38) = Sheets("Rechnung").Cells(42, 4) 'Anzal
ActiveCell.Offset(0, 39) = Sheets("Rechnung").Cells(42, 5) 'Beschreibung
ActiveCell.Offset(0, 40) = Sheets("Rechnung").Cells(43, 4) 'Anzal 18-24
ActiveCell.Offset(0, 41) = Sheets("Rechnung").Cells(43, 5) 'Beschreibung
ActiveCell.Offset(0, 42) = Sheets("Rechnung").Cells(44, 4) 'Anzal 19-24
ActiveCell.Offset(0, 43) = Sheets("Rechnung").Cells(44, 5) 'Beschreibung
ActiveCell.Offset(0, 44) = Sheets("Rechnung").Cells(45, 4) 'Anzal 20-24
ActiveCell.Offset(0, 45) = Sheets("Rechnung").Cells(45, 5) 'Beschreibung
ActiveCell.Offset(0, 46) = Sheets("Rechnung").Cells(46, 4) 'Anzal 21-24
ActiveCell.Offset(0, 47) = Sheets("Rechnung").Cells(46, 5) 'Beschreibung
ActiveCell.Offset(0, 48) = Sheets("Rechnung").Cells(47, 4) 'Anzal 22-24
ActiveCell.Offset(0, 49) = Sheets("Rechnung").Cells(47, 5) 'Beschreibung
ActiveCell.Offset(0, 50) = Sheets("Rechnung").Cells(48, 4) 'Anzal 23-24
ActiveCell.Offset(0, 51) = Sheets("Rechnung").Cells(48, 5) 'Beschreibung
ActiveCell.Offset(0, 52) = Sheets("Rechnung").Cells(49, 4) 'Anzal 24-24
ActiveCell.Offset(0, 53) = Sheets("Rechnung").Cells(49, 5) 'Beschreibung
ActiveCell.Offset(0, 54) = Sheets("Rechnung").Cells(50, 4) 'Anzal 25-30
ActiveCell.Offset(0, 55) = Sheets("Rechnung").Cells(50, 5) 'Beschreibung
ActiveCell.Offset(0, 56) = Sheets("Rechnung").Cells(51, 4) 'Anzal 26-30
ActiveCell.Offset(0, 57) = Sheets("Rechnung").Cells(51, 5) 'Beschreibung
ActiveCell.Offset(0, 58) = Sheets("Rechnung").Cells(52, 4) 'Anzal 27-30
ActiveCell.Offset(0, 59) = Sheets("Rechnung").Cells(52, 5) 'Beschreibung
ActiveCell.Offset(0, 60) = Sheets("Rechnung").Cells(53, 4) 'Anzal 28-30
ActiveCell.Offset(0, 61) = Sheets("Rechnung").Cells(53, 5) 'Beschreibung
ActiveCell.Offset(0, 62) = Sheets("Rechnung").Cells(54, 4) 'Anzal 29-30
ActiveCell.Offset(0, 63) = Sheets("Rechnung").Cells(54, 5) 'Beschreibung
Dim lgErg As Long
Dim wksArt As Worksheet
Dim wksRe As Worksheet
Dim wksGu As Worksheet
Dim intRe As Integer
Dim intGu As Integer
Set wksArt = Sheets("Artikel")
Set wksRe = Sheets("Rechnung")
Set wksGu = Sheets("Gutschrift")
intRe = 26
intGu = 26
Do Until intRe > 55 Or IsEmpty(wksRe.Cells(intRe, 5))
lgErg = WorksheetFunction.Match(wksRe.Cells(intRe, 5), Sheets("Artikel").Range("B10:B53"), 0)
If wksArt.Cells(lgErg + 9, 3) = "Getränke Pfand" Then
wksGu.Cells(intGu, 7) = wksRe.Cells(intRe, 5)
wksGu.Cells(intGu, 4) = wksRe.Cells(intRe, 4)
intGu = intGu + 1
End If
intRe = intRe + 1
Loop
Sheets("Gutschrift").Select
Zahl = Cells(59, 12)
Select Case Zahl
Case Is > 0
Sheets("Gutschrift").Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=0, Collate:=True
End Select
'    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Journal Gutschrift").Select 'Übertrag v. Rechnung n. Journal Gutsch.
Range("A:A").Select
'Selection.SpecialCells(xlBlanks).Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5)       ' Kunden Name
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Gutschrift").Cells(19, 10) ' RechngNr
ActiveCell.Offset(0, 5) = Sheets("Gutschrift").Cells(18, 10) ' RechndDatum
ActiveCell.Offset(0, 6) = Sheets("Gutschrift").Cells(61, 5) 'MWSt 7%
ActiveCell.Offset(0, 7) = Sheets("Gutschrift").Cells(61, 7) ' MWSt 16%
ActiveCell.Offset(0, 8) = Sheets("Gutschrift").Cells(61, 10) 'MWSt Gesamt
ActiveCell.Offset(0, 9) = Sheets("Gutschrift").Cells(70, 12) 'Zahlbetrag
ActiveCell.Offset(0, 10) = Sheets("Gutschrift").Cells(64, 11) 'Bezahle Betrag
ActiveCell.Offset(0, 11) = Sheets("Gutschrift").Cells(65, 11) 'Offene Betrag
ActiveCell.Offset(0, 12) = Sheets("Gutschrift").Cells(62, 12) 'Pfand Bezahlt
ActiveCell.Offset(0, 13) = Sheets("Gutschrift").Cells(70, 10) 'Pfand Rückgabe
ActiveCell.Offset(0, 14) = Sheets("Gutschrift").Cells(64, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 15) = Sheets("Gutschrift").Cells(64, 5) 'Pfand Artikel
ActiveCell.Offset(0, 16) = Sheets("Gutschrift").Cells(65, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 17) = Sheets("Gutschrift").Cells(65, 5) 'Pfand Artikel
ActiveCell.Offset(0, 18) = Sheets("Gutschrift").Cells(66, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 19) = Sheets("Gutschrift").Cells(66, 5) 'Pfand Artikel
ActiveCell.Offset(0, 20) = Sheets("Gutschrift").Cells(67, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 21) = Sheets("Gutschrift").Cells(67, 5) 'Pfand Artikel
ActiveCell.Offset(0, 22) = Sheets("Gutschrift").Cells(68, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 23) = Sheets("Gutschrift").Cells(68, 5) 'Pfand Artikel
ActiveCell.Offset(0, 24) = Sheets("Gutschrift").Cells(69, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 25) = Sheets("Gutschrift").Cells(69, 5) 'Pfand Artikel
ActiveCell.Offset(0, 26) = Sheets("Gutschrift").Cells(70, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 27) = Sheets("Gutschrift").Cells(71, 5) 'Pfand Artikel
ActiveCell.Offset(0, 28) = Sheets("Gutschrift").Cells(72, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 29) = Sheets("Gutschrift").Cells(73, 5) 'Pfand Artikel
ActiveCell.Offset(0, 30) = Sheets("Gutschrift").Cells(74, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 31) = Sheets("Gutschrift").Cells(75, 5) 'Pfand Artikel
ActiveCell.Offset(0, 32) = Sheets("Gutschrift").Cells(76, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 33) = Sheets("Gutschrift").Cells(77, 5) 'Pfand Artikel
ActiveCell.Offset(0, 34) = Sheets("Gutschrift").Cells(78, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 35) = Sheets("Gutschrift").Cells(79, 5) 'Pfand Artikel
ActiveCell.Offset(0, 36) = Sheets("Gutschrift").Cells(80, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 37) = Sheets("Gutschrift").Cells(81, 5) 'Pfand Artikel
ActiveCell.Offset(0, 38) = Sheets("Gutschrift").Cells(82, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 39) = Sheets("Gutschrift").Cells(83, 5) 'Pfand Artikel
Sheets("Gutschrift").Select
Range("G26:G55").ClearContents
Range("D26:D55").ClearContents
Range("A1").Select
' Arbeitsmappen werden wieder verstekt
Sheets("Verkaufte Artikel-Normal").Select
Dim wks As Worksheet
Dim iQuell As Integer, iGetr As Integer
Dim lgZeile As Long, iZaehl As Integer
Set wks = Worksheets("Verkaufte Artikel")
'alle Zeilen in Verkaufte Artikel ab Zeile 10
For lgZeile = 10 To Range("A65536").End(xlUp).Row
Range(Cells(lgZeile, 1), Cells(lgZeile, 5)).Copy wks.Cells(lgZeile, 1)
'alle "Getränke" in "Verkaufte Artikel Statistik"
For iGetr = 7 To 49
'alle Artikelbeschreibungen in "Verkaufte Artikel"
For iQuell = 8 To 60
If Cells(lgZeile, iQuell) = wks.Cells(9, iGetr) Then
iZaehl = iZaehl + Cells(lgZeile, iQuell - 1)
End If
Next
If iZaehl <> 0 Then
wks.Cells(lgZeile, iGetr) = iZaehl
Else
wks.Cells(lgZeile, iGetr) = ""
End If
iZaehl = 0
Next
Next
'ActiveSheet.Protect ("test")
Sheets("Rechnung").Select
ActiveSheet.Protect ("test")
Worksheets("Kunden").Visible = xlVeryHidden
Worksheets("Forderungen").Visible = xlVeryHidden
Worksheets("Einnahmen Übersicht").Visible = xlVeryHidden
Worksheets("Journal Gutschrift Übersicht").Visible = xlVeryHidden
Worksheets("Personal").Visible = xlVeryHidden
Worksheets("Artikel").Visible = xlVeryHidden
Worksheets("Kundenpreise").Visible = xlVeryHidden
Worksheets("Infos f YH").Visible = xlVeryHidden
Worksheets("Journal").Visible = xlVeryHidden
Worksheets("Lieferart").Visible = xlVeryHidden
Worksheets("Verkaufte Artikel").Visible = xlVeryHidden
Worksheets("Verkaufte Artikel-Normal").Visible = xlVeryHidden
Worksheets("Pfand Kosten").Visible = xlVeryHidden
Sheets("ST Verkaufte Artikel Gesamt").Visible = xlVeryHidden
Sheets("ST Pfand Kosten").Visible = xlVeryHidden
Worksheets("Gutschrift").Visible = xlVeryHidden
Worksheets("Journal Gutschrift").Visible = xlVeryHidden
Rechnung = Sheets("Rechnung").Select
Range("A1").Select
Sheets("Rechnung").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=0, Collate:=True
Range("A1").Select
sExit:
Application.CommandBars("Stop Recording").Visible = False
Range("D26:D55").ClearContents
Range("E26:E55").ClearContents
Range("D64:D69").ClearContents
Range("E64:E69").ClearContents
Range("K64").ClearContents
Range("A1").Select
On Error GoTo 0
'VBA bzw. Makroausführung im Hintergrund ist nicht mehr aktiv
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performance Steigerung meines VBA Codes
27.06.2004 05:08:04
Folker
Hallo,
dein Code ist etwas zu lang um ihn sich genau anzusehen. Aber hier ein paar Tipps.
Das mit dem select vermeiden ist erst einmal das wichtigste.
Du musst einfach alle deine Ranges mit dem vollen Pfad ansprechen. Also nicht
Sheets("Rechnung").Select
Kundenname = Range("E18").Value
sonder direkt Kundenname = Sheets("Rechnung").Range("E18").Value
kannst dir auch Variablen für die worksheets oder workbooks deklarieren
dim rechnungen as worksheet
set rechnungen = Sheets("Rechnung")
Kundenname = rechnungen.Range("E18").Value
und das konsequent durchziehen so dass keine selects und activecells mehr da sind.
Ich finde auch diese Konstruktion etwas seltsam
For x = 26 To 55
Artikelname$ = Range("E" & x).Value '1. wurde ersetzt
next
besser und schneller ist sowas wie
for each rng in range(rechnungen.range("E26"), rechnungen.range("E55"))
Artikelname$ = rng.Value '1. wurde ersetzt
next rng
Gruß Folker
Anzeige
AW: Performance Steigerung meines VBA Codes
27.06.2004 08:06:29
andre
Hallo Housein,
- das mit dem select solltest Du im ganzen code prüfen, aber da hattest Du in einem vorigen Thread auch schon mal den Hinweis...
- das mit den vielen Einträgen solltest Du in ein 

Sub packen, beim Aufruf den Blattnamen übergeben und in Abhängigkeit davon den einzutragenden Umfang festlegen:
allgemein:


Sub test1()
test2 "Willi"
End Sub





Sub test2(ByVal parameter As String)
MsgBox parameter
End Sub



Bei Dir z.B.

Hauptprogramm dort wo jetzt der Part für ein Blatt steht:

...

Eintrag "Verkaufte Artikel-Normal"

...

Unterprogramm:

Private 


Sub Eintrag(byval BlattName As String)
Sheets(BlattName).Activate 'Übertrag v. Rechnung n. Journal Gutsch.
'    Range("A:A").Select 'weg damit
'Selection.SpecialCells(xlBlanks).Select
Range("A65536").End(xlUp).Offset(1, 0).Select 'auch .Activate
' jetzt die Codes, die bei allen gleich sind, z.B.
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5)       ' Kunden Name
' dann der spezielle Teil
If BlattName = "Verkaufte Artikel-Normal" Then
End If
If BlattName = "Journal" Then
End If
If BlattName = "Journal Gutschrift" Then
End If
<img src="https://www.herber.de/bbs/user/6626.gif" border=0 align="left" hspace="12" vspace="22">
<div style="float: left; text-align:left">
<font face="Castellar">Hoffe geholfen zu haben </font>
<font size="2" color="#6600CC"><em><strong>
<marquee class="ms-toolbar" scrollamount="4" scrolldelay="250" direction="left" width="190">Grüße aus Gera</marquee>
<hr size="3"></strong></em></font></div><br><br>
<FONT Size=2><FONT FACE="Arial,FixedSys"Size=2>
Anzeige
AW: Performance Steigerung meines VBA Codes
28.06.2004 11:37:44
Y. Housein
Hallo,
wie kann ich den unten genannten Codes optimieren bzw. schneller machen:
Code 1:
For x = 26 To 55
Range("E" & x).Select
Artikelname$ = ActiveCell.Value
Range("d" & x).Select
Menge = ActiveCell.Value
Range("E" & x).Select
Sheets("artikel").Select
Range("B9").Select
'vermeide das ganze "hin-und her-"selektieren.
' Ersetze z.B.
' Range("E" & x).Select
' Artikelname$ = ActiveCell.Value
' durch
' Artikelname$ = Range("E" & x).Value
For a = 10 To ActiveCell.SpecialCells(xlLastCell).Row + 1
'Range("B" & A).Select
Artikelname1$ = Range("B" & a).Value
If Artikelname1$ = Artikelname$ Then
Range("H" & a).Select
Bestand = Range("H" & a).Value - Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next a
Sheets("Rechnung").Select
Range("E" & x).Select
Next x
For y = 64 To 69
'Range("E" & y).Select
'Artikelname$ = ActiveCell.Value
Artikelname$ = Range("E" & x).Value
'Range("d" & y).Select
Menge = Range("d" & y).Value
Range("E" & y).Select

'-----------------------------------------------------------------------
Sheets("artikel").Select
Range("B9").Select
For B = 11 To ActiveCell.SpecialCells(xlLastCell).Row + 1
Range("B" & B).Select
Artikelname1$ = ActiveCell.Value
If Artikelname1$ = Artikelname$ Then
Range("K" & B).Select
Bestand = ActiveCell.Value + Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next B

Sheets("Rechnung").Select
Range("E" & x).Select
Next y
Vorschlag in Forum, funktioniert leider nicht!!!
With wksRe
For x = 26 To 55
Artikelname = .Range("E" & x)
Menge = .Range("D" & x).Value
For a = 10 To wksArt.Cells(Rows.Count, 2).End(xlUp).Row
If wksArt.Range("B" & a) = Artikelname Then
wksArt.Range("H" & a) = wksArt.Range("H" & a).Value - Menge
Exit For
End If
Next a
Next x
End With
Anzeige
AW: Performance Steigerung meines VBA Codes
30.06.2004 05:37:26
andre
Hallöchen,
1. In Deinem ersten code hast Du immer noch zu viele select drin, nimmst Du die auch noch raus? Das wuede Dir ja schon mehrfach gesagt und gilt nicht nur für die Artikelnamen. Da ist mitdenken gefragt, sonst macht die Arbeit den Antwortern auch keinen Spaß ... ;-)
2. Was kommt denn für ein Fehler, in welcher Zeile, was geht nicht? Hier im Forum hat schließlich keiner Deine Daten und da lässt sich das nicht nachvollziehen.
AW: Performance Steigerung meines VBA Codes
30.06.2004 12:22:05
Y. Housein
Habe den Fehler gefunden. Ich danke dir wirklich für deine Hilfe. Stimmt mit denken schadet nicht ;-)
Gruß
Y. Housein

305 Forumthreads zu ähnlichen Themen

VBA - Zelle kopieren bis Wert einer Zelle null ist
Schulze

Halli Hallo,
ich bin ziemlicher Neuling in VBA. Daher würde ich euch bitten mir bei meiner Fragestellung zu helfen und zwar wie folgt: Ich möchte aus einer Tabelle aller Zellen kopieren, bis der Wert einer Zelle 0 annimmt. Diesen bestimten Bereich möchte ich in einer neuen Datei abspeichern...
19.08.2008 08:39:35
Thread-ID: 1002782
17 Beiträge
Anzeige
Zelleninhalt mit VBA suchen
Tom

Hallo
zum Feierabend noch mal fix ne Frage
ich möchte in einem anderen sheet, in einer anderen Tabelle etwas suchen und danach 4 Zellen nach links gehen und den Wert kopieren...
Dim strActiveCell As String
Dim rFound As Range
Tabellenname = ActiveSheet.Name
Tabellenname...
04.09.2008 16:41:17
Thread-ID: 1007457
4 Beiträge
Beim Kopieren eines Tabellenblattes den VBA-Code e
Alfi

Hallo Excel-Gemeinde!
ich habe eine mehrblättrige Datei, per Makro kopiere ich ein Blatt und speichere dieses unter neuem Namen ab.
Dieses Blatt soll aber nicht mehr den VBA-Code der ursprübglichen Datei enthalten, sprich ein Blatt ohne Makros.
Wer kann mir helfen?
So sieht der...
09.09.2008 09:58:00
Thread-ID: 1008333
8 Beiträge
Anzeige
erzwungener zeilenumbruch in Zelle
Lars

Hallo,
obwohl ich schon viel mit Excel gemacht habe, tauchen doch immer wieder Fragen auf:
Gibt es eine Möglichkeit, in einer Zelle einen Zeilenumbruch manuell einzufügen, ohne dass man bereits am Zellenende ist?
Ich denke, dass ist eine eher dumme Frage, aber ich habe derzeit keine...
02.10.2008 15:40:00
Thread-ID: 1013906
4 Beiträge
Array-Formel in VBA-Code umwandeln?
Robert

Hallo,
ich bräuchte bitte eure Hilfe.
Hab folgende Formel...
Selection.FormulaArray = _
=IF(ROW(R[-107]C[-3])>COUNTA('1'!R5C[4]:R200C[4]),"""",INDEX('1'!R5C4:R200C4,SMALL(IF('1'!R5C[4]:R200C[4]<>"""",ROW(R1:R196),""""),ROW(R[-107]C[-3]))))"
Mein Problem ist, dass ic...
26.10.2008 10:56:28
Thread-ID: 1019326
13 Beiträge
Code per VBA in "Diese Arbeitsmappe"
Timo

Hallo,
mir ist bekannt, wie ich per VBA ein neues Modul anlegen und eine Sub erzeugen kann.
Ich möchte nun aber per VBA eine sub in "Diese Arbeitsmappe" erzeugen und mit einer zweiten Prozedur wieder löschen.
Geht das?
Ich habe im Archiv nichts relevantes hierzu gefunden.
V...
29.10.2008 11:37:00
Thread-ID: 1020207
6 Beiträge
VBA heutiges Datum finden und Inhalt der Zelle prü
NeptunesChild

Hallo Leutz,
ich möchte in einer Zeiterfassung auf einem Monatsblatt das heutige Datum finden, dann in einer anderen Spalte (5 weiter links) eine Uhrzeit eintragen. Zuvor soll aber die Kontrolle erfolgen, ob in der Zelle bereits etwas steht und ob dies kleiner ist, als die aktuelle Zeit. We...
06.11.2008 15:38:08
Thread-ID: 1022323
3 Beiträge
Leere Zelle suchen, Wert eintragen VBA
andreas

Hallo zusammen,
habe ein kleines Formular mit zwei "Command-Button".
Bei drücken von "Zufügen" soll die nächst leere Zelle im Bereich "F3:J3500" gesucht werden und ein "x" eingetragen werden.
Bei drücken von "Entfernen" suche im selben Bereich die letzte ausgefüllte Zelle und diese...
19.11.2008 11:57:07
Thread-ID: 1025960
2 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
16
5
3
7
4
3
12
5
2
1
2
7
6
2
5
3
2
2
4
2
4
4
7
4
4