Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
536to540
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
536to540
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kann mir jemand bei ARRAY helfen?

kann mir jemand bei ARRAY helfen?
25.12.2004 20:19:07
Edwin
Hallo,
ich habe mein Zeit-Problem leider noch immer.
Folgender Code benötigt für die Ausführung 51 Sekunden.
Nun habe ich bei VB-Fun.de einen Tipp gelesen, der wohl auf mich passen würde, aber mit meinen absoluten Anfängerkenntnissen, kann ich den Tipp nicht umsetzen.
Wäre jemand so lieb und würde mir meinen Code entsprechend umschreiben?
Hier der Tipp:
http://www.vb-fun.de/cgi-bin/loadframe.pl?ID=vb/tipps/tip0414.shtml
Hier mein Code:

Sub ProduktionEintragen()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Wochenbericht")
Set ws2 = Worksheets("Produktion")
anz = ws2.Cells(65536, 1).End(xlUp).Row
z = 8
ws1.Range("F8:K46").ClearContents
If ws1.Cells(2, 8) <> "" Then
For Each c In ws2.Range("A2:A" & anz)
If c.Value Like ws1.Cells(2, 5) & "-" & Year(ws1.Cells(1, 19)) & "-" & ws1.Cells(2, 8) & "*" Then
zeile = c.Row
ws1.Cells(z, 6) = ws2.Cells(zeile, 2)
ws1.Cells(z, 7) = ws2.Cells(zeile, 3)
ws1.Cells(z, 8) = ws2.Cells(zeile, 4)
ws1.Cells(z, 9) = ws2.Cells(zeile, 5)
ws1.Cells(z, 10) = ws2.Cells(zeile, 6)
ws1.Cells(z, 11) = ws2.Cells(zeile, 7)
z = z + 1
End If
Next
End If
End Sub

Vielen Dank und frohe Weihnachten!
Gruß
Edwin

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

Betreff
Datum
Anwender
Anzeige
Klassischer Fall für die Find-Methode
Boris
Hi Edwin,
hab mir jetzt das Beispiel nicht angesehen - aber aufgrund deines Codes würd ich mal sagen, dass du mit der Find-Methode (und FindNext) wesentlich flotter unterwegs wärst.
Wenn du mal deine Datei auf den Server lädst und genau beschreibst, was gemacht werden soll, dann kann man den Code auch eben zusammenbasteln.
Grüße Boris
P.S: Mit Array hat das recht wenig zu tun...
AW: Klassischer Fall für die Find-Methode
25.12.2004 20:50:33
Edwin
Hallo,
hier meine Datei.
https://www.herber.de/bbs/user/15302.xls
Sie ist aber bei weitem noch nicht fertig.
Bitte im Sheet "Wochenbericht" den Makro "ProduktionEintragen" ausführen.
Wie gesagt es dauert eine Ewigkeit, obwohl gar nicht viel abgefragt und eingetragen werden muss.
Gruß
Edwin
Anzeige
AW: Klassischer Fall für die Find-Methode
Boris
Hi Edwin,
auf die Schnelle - versuch mal das:
Option Explicit
Sub ProduktionEintragen2()
'TestAnfang
Dim Anfang As Date
Dim Ende As Date
Dim Zeitspanne As Date
Dim rngSearch As Range
Dim z As Long, C As Range
Dim strSearch As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim firstAddr As String
Anfang = Time
Set ws1 = Worksheets("Wochenbericht")
Set ws2 = Worksheets("Produktion")
Set rngSearch = ws2.[a:a]
z = 8
With ws1
.Range("F8:K46").ClearContents
If .Cells(2, 8) <> "" Then
strSearch = .Cells(2, 5) & "-" & Year(.Cells(1, 19)) & "-" & .Cells(2, 8) & "*"
Set C = rngSearch.Find(strSearch, lookat:=xlPart, MatchCase:=True)
If Not C Is Nothing Then
firstAddr = C.Address
Do
.Range(Cells(z, 6), Cells(z, 11)) = C.Offset(0, 1).Resize(1, 6).Value
z = z + 1
Set C = rngSearch.FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddr
End If
End If
End With
'TestAnfang
Ende = Time
Zeitspanne = Ende - Anfang
Debug.Print "verbrauchte Zeit: " & Zeitspanne & " Uhrzeit: " & Time
'TestEnde
End Sub

Grüße Boris
Anzeige
AW: Klassischer Fall für die Find-Methode
Edwin
Hallo Boris,
vielen Dank für Deine Hilfe, jetzt bin ich bei 11 Sekunden. Super!!!
Kannst Du mir auch sagen, warum der solange rödelt?
Wenn ich doch nur auch so viel von VBA verstehen würde. :-((
Ich schaue mir morgen Dein Code genau an und hoffe, dass ich dann kapiere was Du da gezaubert hast.
Im Moment verstehe ich nur Bahnhof. Hauptsache es geht.
Gruß
Edwin
Jetzt dauert er nur noch 1 Sekunde...
Boris
Hi Edwin,
Berechnung auf manuell, Bildschirmaktualisierung während des Codes noch ausschalten:
Option Explicit
Sub ProduktionEintragen2()
'TestAnfang
Dim Anfang As Date
Dim Ende As Date
Dim Zeitspanne As Date
Dim rngSearch As Range
Dim z As Long, C As Range
Dim strSearch As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim firstAddr As String
Anfang = Time
Set ws1 = Worksheets("Wochenbericht")
Set ws2 = Worksheets("Produktion")
Set rngSearch = ws2.[a:a]
z = 8
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With ws1
.Range("F8:K46").ClearContents
If .Cells(2, 8) <> "" Then
strSearch = .Cells(2, 5) & "-" & Year(.Cells(1, 19)) & "-" & .Cells(2, 8) & "*"
Set C = rngSearch.Find(strSearch, lookat:=xlPart)
If Not C Is Nothing Then
firstAddr = C.Address
Do
.Range(Cells(z, 6), Cells(z, 11)) = C.Offset(0, 1).Resize(1, 6).Value
z = z + 1
Set C = rngSearch.FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddr
End If
End If
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'TestAnfang
Ende = Time
Zeitspanne = Ende - Anfang
Debug.Print "verbrauchte Zeit: " & Zeitspanne & " Uhrzeit: " & Time
'TestEnde
End Sub

Grüße Boris
Anzeige
Jippie!!!
Edwin
Hallo Boris,
vielen vielen Dank.
Das war ein ganz tolles Weihnachtsgeschenk. Damit hast Du mir eine große Freude gemacht.
Gruß
Edwin

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige