Array

Hallo zusammen,
ich hab ein Skript, was zwar funktionell hervorragend läuft, nur läßt aufgrund der großen Datenmenge die Geschwindigkeit zu wünschen übrig. Die Bearbeitung dauert mehrere Minuten. Nun würde ich gern die Daten in ein Array einlesen und bearbeiten, dazu muß jedoch das Skript angepaßt werden. Leider bin ich mit
Arrays nicht gerade fit.
Das Skript hat folgende Funktion:
-Artikelnummern aus einer Spalte in zwei Tabellen werden miteinander verglichen
-falls in Tabelle1 Werte NICHT in Tabelle2 gefunden werden wird die gesamte Zeile aus Tabelle1 in Tabelle2 kopiert (Aktualisierung)
Hier das Stückchen Code dazu:
lZeileC = 1
lSpalteA = 9999
lSpalteB = 9999
For lZeileA = 1 To lSpalteA
bGefunden = False
For lZeileB = 1 To lSpalteB
If Worksheets(Tempsheet).Range("A" & lZeileA).Value = Worksheets(Tempsheet2).Range("A" & lZeileB).Value Then
bGefunden = True
Exit For
End If
Next lZeileB
If bGefunden = False Then
Sheets(Tempsheet).Rows(lZeileA).Copy Destination:=Sheets(destsheet).Cells(lZeileC, 1)
lZeileC = lZeileC + 1
End If
Next lZeileA
Danke schonmal im voraus für Eure Hilfe!
Tobias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Array

07.12.2005 10:04:54

Matthias

AW: Array

07.12.2005 10:24:15

bst

AW: Array - Vielen Dank! o.T.

07.12.2005 15:48:08

Tobias

Auch Hallo,
versuch's mal so. Um's noch schneller zu machen mußt Du vermutlich das Array arrB sortieren um danach binär darin suchen zu können.
cu, Bernd
--
Option Explicit

Const tempsheet As Integer = 1
Const tempsheet2 As Integer = 2
Const destsheet As Integer = 3

Sub CopySomeLines()
   Dim lzeileA As Long, lZeileB As Long, lZeileC As Long
   Dim lZeileAMax As Long, lZeileBMax As Long
   Dim bgefunden As Boolean, arrA, arrB
   Dim t As Single, t2 As Single
   t = Timer
   lZeileC = 1
   With Worksheets(tempsheet)
      lZeileAMax = .Cells(.Rows.Count, 1).End(xlUp).Row
      arrA = .Range(.Cells(1, 1), .Cells(lZeileAMax, 1))
   End With

   With Worksheets(tempsheet2)
      lZeileBMax = .Cells(.Rows.Count, 1).End(xlUp).Row
      arrB = .Range(.Cells(1, 1), .Cells(lZeileBMax, 1))
   End With

   For lzeileA = 1 To lZeileAMax
      bgefunden = False
      For lZeileB = 1 To lZeileBMax
         If arrA(lzeileA, 1) = arrB(lZeileB, 1) Then
            bgefunden = True
            Exit For
         End If
      Next lZeileB

      If bgefunden = False Then
         Sheets(tempsheet).Rows(lzeileA).Copy Destination:=Sheets(destsheet).Cells(lZeileC, 1)
         lZeileC = lZeileC + 1
      End If
   Next lzeileA
   t2 = Timer
   Debug.Print t2 - t
End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread