Anzeige
Archiv - Navigation
1240to1244
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
Inhaltsverzeichnis

VBA-Code zu langsam

VBA-Code zu langsam
eVoLa
Hallo liebe Gemeinde,
ich habe mir ein Makro zusammengebastelt zur Erstellung einer Listview,
funktioniert auch total super, nur ein wenig zu langsam.
Die Listview muss sich halt ständig aktualisieren, da aber Schleife in Schleife ist
dauert es immer 4 sekunden statt einer. Vielleicht hat ja jemand von euch eine Idee,
wie man dies beschleunigen kann.
Nachfolgend mein Makro:
_________________
Option Explicit
Sub list_test()
Application.ScreenUpdating = False
Dim x As Long
Dim a As Long
Dim ix As ListItem
With frmListview.ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "Name", 110
.ColumnHeaders.Add , , "D.", 30
.ColumnHeaders.Add , , "VBK", 50
.ColumnHeaders.Add , , "maxD", 30
.ColumnHeaders.Add , , "FS", 30
.ColumnHeaders.Add , , "PKW", 30
.Gridlines = True
.View = 3
For x = 1 To 290
.ListItems.Add , , Cells(x + 1, 20)
If .ListItems(x).Text = "0" Then
.ListItems(x).ForeColor = vbWhite
.ListItems.Remove (1)
.ListItems.Remove (1)
.ListItems.Remove (1)
Exit Sub
End If
.ListItems(x).SubItems(1) = Cells(x + 1, 21)
.ListItems(x).SubItems(2) = Cells(x + 1, 22)
If .ListItems(x).SubItems(2) = "-" Then
.ListItems(x).ForeColor = vbRed
End If
For a = 5 To 290
If .ListItems(x).Text = Cells(a, 5).Text Then
.ListItems(x).ForeColor = vbGreen
End If
Next
.ListItems(x).SubItems(3) = Cells(x + 1, 23)
.ListItems(x).SubItems(4) = Cells(x + 1, 24)
.ListItems(x).SubItems(5) = Cells(x + 1, 25)
Next
.ListItems.Remove (1)
.ListItems.Remove (1)
.ListItems.Remove (1)
End With
Application.ScreenUpdating = True
End Sub
______________
Eventuell hat ja jemand von euch eine Idee.
Vielen Dank schon im Voraus

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA-Code zu langsam
04.12.2011 20:46:00
Daniel
Hi
du kannst das ganze noch beschleunigen, indem du die Zellinhalte in ein Array liest und dieses verwendest, um die langsamen Zugriffe auf Excelzellen mit .Cells zu vermeiden.
dh am makrobeginn steht folggender Befehl:
Dim arr
arr = Range("A1:Y291").Value
im folgenden ersetzt du dann jedes Cells(..) durch arr(...).
die Paramenter innerhalb der Klammern kannst du 1:1 übernehmen.
Gruß, Daniel
AW: VBA-Code zu langsam
04.12.2011 21:15:32
eVoLa
erstmal vielen dank.
habe es auch sofort probiert, leider ohne spürbare schnellere Ergebnisse.
Problem ist ja, das es ja pro item nochmal eine Schleife ausgeführt wird.
das heißt 290 mal 290 Schleifen. Vielleicht kurz zur funktion:
Die Liste aktualisiert sich immer nach einem Doppelklick in der Liste und bei jedem Blattwechsel.
Bei jedem Item was hinzugefügt wird schaut er gleich ob es bereits in einem
anderen Bereich existiert, Zeile für Zeile, wenn ja dann färbt er es grün.
Vielleicht eine Idee wie ich das umgehen kann?
LG und Danke!!!
Anzeige
AW: VBA-Code zu langsam
04.12.2011 21:40:48
Josef

Hallo ?,
probier es so.
Sub list_test()
  Application.ScreenUpdating = False
  Dim x As Long
  Dim a As Long
  
  Dim ix As ListItem
  With frmListview.ListView1
    .ListItems.Clear
    .ColumnHeaders.Clear
    
    .ColumnHeaders.Add , , "Name", 110
    .ColumnHeaders.Add , , "D.", 30
    .ColumnHeaders.Add , , "VBK", 50
    .ColumnHeaders.Add , , "maxD", 30
    .ColumnHeaders.Add , , "FS", 30
    .ColumnHeaders.Add , , "PKW", 30
    
    .Gridlines = True
    
    .View = 3
    For x = 1 To 290
      If Cells(x + 1, 20) <> 0 Then
        .ListItems.Add , , Cells(x + 1, 20)
        .ListItems(x).SubItems(1) = Cells(x + 1, 21)
        .ListItems(x).SubItems(2) = Cells(x + 1, 22)
        .ListItems(x).SubItems(3) = Cells(x + 1, 23)
        .ListItems(x).SubItems(4) = Cells(x + 1, 24)
        .ListItems(x).SubItems(5) = Cells(x + 1, 25)
        If .ListItems(x).SubItems(2) = "-" Then
          .ListItems(x).ForeColor = vbRed
        End If
        If IsNumeric(Application.Match(.ListItems(x).Text, Range("E5:E290"), 0)) Then
          .ListItems(x).ForeColor = vbGreen
        End If
      End If
    Next
    .ListItems.Remove (1) '?
    .ListItems.Remove (1)
    .ListItems.Remove (1)
    
  End With
  Application.ScreenUpdating = True
  
End Sub



« Gruß Sepp »

Anzeige
AW: VBA-Code zu langsam
04.12.2011 21:50:11
eVoLa
Super !!!!Vielen Dank.
Hab die ganze Zeit versucht die Schleife zu ersetzen, aber diese Variante kannte ich noch nicht.
Merci Vielmals!!!!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige