Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1600to1604
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
Muster VBA Fortschrittsbalken integrieren?
06.01.2018 07:59:22
Jürgen
Hallo zusammen,
das Thema eines Fortschrittsbalken ist ja ziemlich oft zu finden.
Mein Problem als VBA DAU ist es allerdings das gefundene Beispiel in mein Projekt zu integrieren. Evtl. könnte mir jemand Hilfe dazu geben.
Der Muster Fortschrittsbalken wäre der hier:
https://www.herber.de/bbs/user/118719.xlsm
Mein VBA Code, welcher txt-Daten importiert lautete so:
Dim dateien()
Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim j As Long
Dim zeile As String
Dim inhalt
Dim Ende
Dim nr
Dim utf As Boolean
Dim prüfen As Boolean
Dim erstezeile As Boolean
Dim text As String
ReDim dateien(0)
dateien(0) = 0
quelle = "D:\ITK\Einspielungen" 'Pfad eintragen
Call txtsuchen(quelle)
If dateien(0) = 0 Then
MsgBox "Keine .txt Dateien gefunden!"
Else
'Daten auslesen
For i = 1 To dateien(0)
DateiName = dateien(i)
Ende = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Ende = Ende + 2
nr = FreeFile()
utf = False
prüfen = False
erstezeile = False
Open DateiName For Input As #nr
Do While Not EOF(nr)
Line Input #nr, zeile
inhalt = Split(zeile, Chr(9))
If prüfen = False Then
If Len(inhalt(0)) > 2 Then
If Asc(Left(inhalt(0), 1)) = 239 And Asc(Mid(inhalt(0), 2, 1)) = 187 And  _
Asc(Mid(inhalt(0), 3, 1)) = 191 Then utf = True
End If
prüfen = True
text = inhalt(2)
End If
For j = 0 To UBound(inhalt)
If utf = True Then
If erstezeile = False Then
If j = 0 Then inhalt(j) = Mid(inhalt(j), 4, Len(inhalt(j)))
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = FromUTF8String(inhalt(j))
erstezeile = True
Else
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = FromUTF8String(inhalt(j))
End If
Else
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = inhalt(j)
End If
Next j
ActiveSheet.Cells(Ende, 6) = text
Ende = Ende + 1
Loop
Close #nr
Next i
End If
Call tausch
ActiveSheet.Range("C:D").Columns.AutoFit
ActiveSheet.Range("C:D").NumberFormat = "0.000000"
Call EventsOn
Call Zellformeln
Dim lngLastUsedRow As Long 'Datensätze auslesen und in MsgBox anzeigen
lngLastUsedRow = Worksheets("Tabelle1").Columns(1).Find(What:="*", LookIn:=xlValues, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
MsgBox "Daten erfolgreich eingelesen!"
End Sub
Wenn ich das UserForm integriert habe, wie müsste ich dann noch den VBA Code von "Private

Sub UserForm_Activate()" zu meinem Import-Code anpassen?
Danke & Gruss,
Juergen


		

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Fortschrittsbalken Nachtrag
06.01.2018 09:04:19
Jürgen
Hallo zusammen,
ich habs mal soweit geschafft, dass der Fortschrittsbalken auf meiner Tabelle läuft. Jetzt müsste ich wissen, wie die Anweisung lautet, dass beim Import meiner Daten die Aktion mit dem Fortschrittsbalken ausgelöst wird? Ich hab keine Ahnung wo man da ansetzt?
Hier mein Beispiel:
https://www.herber.de/bbs/user/118722.xlsm
Danke & Gruss,
Juergen
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 11:26:42
onur
Schau dir das an, dann weisst du, wie es geht.
https://www.herber.de/bbs/user/118724.xls
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 12:05:12
Jürgen
Hallo Onur,
ich glaube, du überschätzt mich ;)
Muss ich mein "Sub DateienLesen()" an die Stelle reinkopieren, welche als "' do something" gekennzeichnet ist?
Weil da crashed es gleich alles bei Ausführung.

Danke & Gruss,
Juergen
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 12:10:49
onur
Schmeiss mal dein progressbar komplett raus und poste die datei (oder die frühere version ohne progressbar), dann baue ich dir meine version ein.
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 12:16:53
Jürgen
Hallo Onur,
vielen Dank für die Hilfe!
Hier meine xlsm-Datei:
https://www.herber.de/bbs/user/118727.xlsm
Danke & GRuss,
Juergen
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 13:21:34
Jürgen
Hallo Onur,
ja, es funktioniert! Toll!
Frage:
ich definiere mal die Zustände des Cursors während des Imort-Vorganges:
1) Click Butto "Daten Import"
2) es zirkuliert der Cursor im Kreis---- [keine Progress Bar sichtbar]
3) es wird der Cursor zum "+"------[Progressbar erscheint und zählt bis 100%, erlischt dann]
4) der Cursor in Form eines "+" pulsiert---- [Progressbar nicht mehr sichtbar]
Bei Schritt 2) denke ich guckt das Programm erstmals in das Verzeichnis und checkt ob txt-Daten drinnen vorhanden sind. Bei 4) schreibt es dann die gefundenen Daten in die Tabelle rein.
Könnte man die Progressbar mit 1) bis incl. Ende 4) sichtbar darstellen? Jetzt ist sie wirklich nur ganz kurz zu sehen. Es soll aber dem User der Status über die ganze Dauer des Vorganges visuell dargestellt werden?
Danke & GRuss,
Juergen
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 14:07:23
onur
poste mir mal ein paar txt dateien zum importieren, je mehr, desto besser, damit auch ich mal testen kann.
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 14:28:06
onur
Du kannst mal vor jedem Sub-Aufruf
t=timer

und dahinter
MsgBox "NameDesSub" & Timer - t

setzen, um zu ermitteln, welche subs wie lange laufen, weil bei einer sec. z.B. macht es keinen Sinn, einen Progressbar zu setzen.
Dann gib mir mal bescheid, wie lang welche sub braucht.
Betrofen wären:
Call txtsuchen(quelle)
Call tausch 

und die zeile
For i = 1 To dateien(0)
im modul1 (in diesem falle t=timer for "For I..." und Msgbox hinter "Next i".
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 15:49:33
Jürgen
Hallo Onur,
vielen Dank für deine Mühe!
Hier die Werte:
- txt suchen: 5,765625
- SchleifeMitProgressbar: 1,222656
- tausch: 37,97266
- Zellformeln: 0,4804688
Hier noch eine Import-Txt-Datei:
https://www.herber.de/bbs/user/118733.zip
Danke & Gruss,
Juergen
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 16:03:37
onur
- txt suchen: 5,765625 - zu gefährlich, da rekursiv (sich selbst aufrufend - Du hättest dann plötzlich zig Progressbaraufrufe)
- SchleifeMitProgressbar: 1,222656 - bereits eingebaut
- tausch: 37,97266 - eingebaut
- Zellformeln: 0,4804688 - lohnt sich nicht
https://www.herber.de/bbs/user/118734.xlsm
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 17:52:05
Jürgen
Hallo Onur,
danke für die Datei.
Leider bekomme ich eine Fehlermeldung wie folgt beim Import-Start:

Danke & Gruss,
Juergen
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 17:57:01
onur
Schreib in modul1 ganz oben:
Public t As Single
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 18:52:20
Jürgen
Hallo Onur,
SUPER SACHE!! Läuft wie geschmiert jetzt!
Vielen herzlichen Dank für deine Geduld & Bemühungen!
Noch ne Frage dazu:
warum ist jetzt der Datenimport wesentlich schneller? Des ist ja der Wahnsinn. Bestimmt 3x so schnell wie ohne Progressbar zuvor?
Danke & Gruss,
Juergen
Anzeige
AW: Muster VBA Fortschrittsbalken integrieren?
06.01.2018 19:09:12
onur
Vorher:
For i = 1 To ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row

Nachher:
max = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 1 To max

Vielleicht deswegen - excel musste bei jeder iteration die letzte zeile berechnen.
Du solltest alle codes in modul2 bis modul5 in modul1 kopieren und diese module dann löschen - ist übersichtlicher.
AW: Super Lösung-Vielen Dank!
06.01.2018 19:30:08
Jürgen
Hallo Onur,
dann freu ich mich gleich 2x: einmal eine tolle Statusbar und dabei ne 1aPerformance Verbesserung!
Das hat sich nun wirklich gelohnt! Bin happy :)
Vielen Dank nochmals für deine Hilfe!
Gruss,
Juergen
Anzeige
AW: Super Lösung-Vielen Dank!
06.01.2018 19:36:02
onur
Kein Problem - Gern geschehen.

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige