Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 15:03:35
Unterschiedliche Dateien miteinander abgleichen lassen
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
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

Wie kann ich mein Code schneller machen

Wie kann ich mein Code schneller machen
26.06.2004 16:30:47
Y.
Hallo zusammen,
wie kann ich den unten genannten Code verbessern. Das läuft extrem langsam.
For x = 26 To 55
Artikelname$ = Range("E" & x).Value
Menge = Range("d" & x).Value
' Menge = ActiveCell.Value
' Range("E" & x).Select
Sheets("artikel").Select
Range("B9").Select


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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tipp
26.06.2004 19:10:58
Christoph
Hallo Y.Housein,
es ist schwierig, so ohne Anfang und ohne Ende des Codes, diesen nachzuvollziehen.
Es ist auch nicht zu erkennen, von welchen Tabellenblatt du den Code startest.
Daher weiss ich auch nicht, welche Zellen hier verglichen werden sollen.
Mein Tipp:
Verzichte auf die ganzen Selects.
Du musst weder einzelne Zellen noch die jeweiligen Tabellenblätter selektieren.
Jede Codezeile, die abgearbeitet werden muss, benötigt Zeit. Und wenn die Hälfte des Codes aus Select-Anweisungen besteht, dann wird der Code entsprechend langsam.
Siehe hierzu:
http://xlfaq.herber.de/xlbasics/main_sel.htm
da findest du du auch entsprechende Beispiele
Gruß
Christoph
Anzeige
AW: Tipp
27.06.2004 04:13:22
Y.
Hi,
leider weis ich nicht mehr, wo bzw. in welche Stelle ich den Code verbessern kann. Ich hoffe du kannst mir genau die Stellen zeigen, wo eine Verbesserung nötig ist, um den Code zu verbessern. Wenn Du mir auch zeigen würdest, wie dann währe ich dir Dankbar. Anbei erhaltest Du, die komplette 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

Anzeige
AW: Tipp
27.06.2004 13:15:37
Chritsoph
Sorry, aber das scheint mir doch etwas verbaut.
Zumal du hier offensichtlich verschiedenste Makros miteinander verwurstelt hast.
Schreib die ganzen Deklarationen mal an den Anfang des Makros. Dann kannst du auch innerhalb des ganzen Makros darauf zugreifen
mal ein Bsp (ohne Garantie das das dann so läuft wie gewünscht)
deine Schleife:
For x = 26 To 55
...
bis
...
Next x
würde ich so schreiben:
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
Ein weiteres Bsp:
Hier kopierst du jeweils nur eine Zeile und das wahrscheinlich 100 mal anstatt gleich den ganzen Bereich zu kopieren
sowas dauert dann nätürlich auch 100 mal so lange.
For lgZeile = 10 To Range("A65536").End(xlUp).Row
Range(Cells(lgZeile, 1), Cells(lgZeile, 5)).Copy wks.Cells(lgZeile, 1)
...
Prinzipiell sind Schleifen kein schneller Weg. Insbesondere, wenn du mehrere Schleifen ineinander verschachtelst.
Hier sind Lösungen wie zB "Match" wesentlich effektiver. (Match funktioniert aber zB nicht, wenn in der Vergleichszeile kein Eintrag steht)
Diese Funktion hast du auch schon an einer Stelle eingesetzt.
Gruß
Christoph
Anzeige

302 Forumthreads zu ähnlichen Themen

VBA Code sicherer machen
SteffenS

Hallo Zusammen,
wie bekomm ich es hin, dass mein Projekt nur eine bestimmte Zeit funktioniert.
Mit einer Zeitabfrage kann ich dies machen, aber dies ist auch sehr schnell auffindbar.
Ich benötige etwas was kompliziert aussieht, damit meine "Ideen" nicht so schnell
weiterverteilt...
17.03.2010 08:39:41
Thread-ID: 1146495
15 Beiträge
Anzeige
VBA Code schneller machen
Rebecca

Hallo Zusammen,
wenn ich in einer vba Prozedur zuviele Abfragen bzw. Ausführungen drin habe, verlangsamt diese die Ausführung? Ist es besser wenn ich eine große Prozedur in viele kleinen packe?
Irgendwie braucht das bei mir etwas zu lang.
LG
Rebecca
18.08.2013 19:59:10
Thread-ID: 1327364
5 Beiträge
Kann man den Code schneller machen?
Frank

Hallo Zusammen!
Ich habe folgenden Code gebastelt:
Private Sub UserForm_Initialize() With frmSpielverlegungen .ListBox1.ColumnCount = 17 .ListBox1.ColumnWidths = "35;155;50;35;35;35;35;35;35;35;35;35;35;35;35;35;35" End With With frmSpielverlegungen .ListBox1.Clear Dim Daten(31, 17) For...
07.09.2015 21:44:37
Thread-ID: 1446420
7 Beiträge
Anzeige
Code schneller machen?
Henno

Hallo Forum,
ich habe folgenden Code per Recorder aufgezeichnet, der auch funktioniert-zumindest wenn die parameter stimmen.
Allerdings dauert es sehr lange.
Der Code wird über einen CommandButton ausgeführt.
Kann mir einer den Code umschreiben, dass er schneller ausgeführt wird...
22.01.2017 10:50:37
Thread-ID: 1536598
12 Beiträge
Code schneller machen
Volker

Guten Morgen zusammen.
bin neu hier und brauch eure Hilfe.
Ich muss große Datenmengen aus einer Datei in eine andere Kopieren.
Verwende diesen Code, der auch funktioniert, aber bei großen Mengen eben ziemlich langsam ist.
Gibt es irgendeine Möglichkeit dies zu beschleunigen?
09.03.2017 09:46:51
Thread-ID: 1546361
7 Beiträge
Code schneller machen
Frank

Hallo Zusammen!
Ich habe mir zum Löschen bestimmter Zellbereiche folgenden Code gebastelt. Ich finde aber es dauert sehr lange, warum nur. Mit meinen bescheidenen Kenntnissen stoße ich da an meine Grenzen. Für jede Hilfe dankbar!
Gruß Frank H.
Application.ScreenUpdating = False
...
05.10.2017 18:18:20
Thread-ID: 1584428
12 Beiträge
fertiger Code - kann man den "schneller" machen ?
reiner

Hallo Forum,
VIELEN DANK nochmal für eure Hilfe bei meinem Problem :
Wert in Spalte suchen und bestimmte Zellen löschen !
Mein Code hier ist folgender : Private Sub CommandButton2_Click() Dim e As Object For Each e In Sheets("Tabelle1").Range("E3:E" & Sheets("Tabelle1").Cells(Ro...
28.11.2017 16:16:23
Thread-ID: 1594187
5 Beiträge
VBA Code "Mac tauglich" machen
Matthias

Hallo Leute,
habe folgenden Code in einer Datei integriert: Sub Speichern2() Dim strDateiname As String Dim objFileDialog As FileDialog ThisWorkbook.Save Set objFileDialog = Application.FileDialog(msoFileDialogSaveAs) strDateiname = "Honorarnote " & Range("G15").Text With objFileDialog...
03.07.2019 20:43:03
Thread-ID: 1700776
3 Beiträge
Anzeige

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
14
8
4
6
7
11
6
11
4
2
4
3
3
6
4
11
4
8
8
4
2
5
1
5
6