Microsoft Excel

Herbers Excel/VBA-Archiv

Makro optimieren, wenn es geht? | Herbers Excel-Forum


Betrifft: Makro optimieren, wenn es geht? von: edie
Geschrieben am: 22.12.2009 18:59:42

Hallo zusammen,

das nachfolgende Makro, aus dem Archiv, habe ich angepasst und es funktioniert
auch, leider bei ca. 15.000 Zeilen in der "DB" ist es langsam.

Eine Datumsreihe in Spalte A der "Tabelle1" wird mit der Spalte A der "DB" verglichen
und bei Übereinstimmungen der Wert aus Spalte C der "DB" in Spalte C der "Tabelle1" kopiert.

Nun meine Frage: Kann das Makro optimiert werden?

Sub Go() 
Dim z%, z1%, lz%, lz1%
Dim sh As Worksheet
Dim sh1 As Worksheet
Set sh = Worksheets("Tabelle1") ‘ Aktuelle Tabelle
Set sh1 = Worksheets("DB")’ Datenbank

lz = sh.Cells(Rows.Count, 1).End(xlUp).Row
lz1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For z = 4 To lz
For z1 = 4 To lz1
If sh.Cells(z, 1) = sh1.Cells(z1, 1) Then

sh.Cells(z, 3) = sh1.Cells(z1, 3)

End If
Next
Next
End Sub
Für jede Hilfe bin ich sehr dankbar. Danke im Voraus.

Grüße

  

Betrifft: AW: Makro optimieren, wenn es geht? von: Josef Ehrensberger
Geschrieben am: 22.12.2009 19:30:14

Hallo Edie,

ungetestet.

Sub Go()
  Dim vntA As Variant, vntRes As Variant
  Dim lngIndexA As Long
  Dim shA As Worksheet, shB As Worksheet, rng As Range
  
  Set shA = Worksheets("Tabelle1") ' Aktuelle Tabelle
  Set shB = Worksheets("DB") ' Datenbank
  
  vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3))
  Set rng = shB.Range(shB.Cells(4, 1), shB.Cells(shB.Cells(shB.Rows.Count, 1).End(xlUp).Row, 1))
  
  
  For lngIndexA = 1 To UBound(vntA, 1)
    vntRes = Application.Match(vntA(lngIndexA, 1), rng, 0)
    If IsNumeric(vntRes) Then
      vntA(lngIndexA, 3) = rng.Cells(vntRes, 1).Offset(0, 2)
    End If
  Next
  
  shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3)) = vntA
  
End Sub



Gruß Sepp



  

Betrifft: jetzt getestet! von: Josef Ehrensberger
Geschrieben am: 22.12.2009 19:53:36

Sub Go()
  Dim vntA As Variant, vntRes As Variant
  Dim lngIndexA As Long
  Dim shA As Worksheet, shB As Worksheet, rng As Range
  
  Set shA = Worksheets("Tabelle1") ' Aktuelle Tabelle
  Set shB = Worksheets("DB") ' Datenbank
  
  vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3))
  Set rng = shB.Range(shB.Cells(4, 1), shB.Cells(shB.Cells(shB.Rows.Count, 1).End(xlUp).Row, 1))
  
  
  For lngIndexA = 1 To UBound(vntA, 1)
    vntRes = Application.Match(CDbl(vntA(lngIndexA, 1)), rng, 0)
    If IsNumeric(vntRes) Then
      vntA(lngIndexA, 3) = rng.Cells(vntRes, 1).Offset(0, 2)
    End If
  Next
  
  shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3)) = vntA
  
End Sub



Gruß Sepp



  

Betrifft: Hurra es funktioniert! von: edie
Geschrieben am: 22.12.2009 19:59:23

Hallo Sepp,

hurra es funktioniert und ist sehr schnell.

Vielen herzlichen Dank. Schönen Abend noch.

Grüße


  

Betrifft: AW: Makro optimieren, wenn es geht? von: edie
Geschrieben am: 22.12.2009 19:56:16

Hallo Sepp,

vielen Dank, es funktioniert noch nicht, aber bin auf der Suche.

In Spalte A der Tabelle1 in ist eine Datumsreihe und in der Spalte A der DB eine sehr lange Datumsreihe.

Bei Übereinstimung soll der Wert aus Spalte C der DB in die Spalte C der Tabelle1 kopiert werden.

Viele Grüße


  

Betrifft: AW: warum Makro schreiben, wenns der SVeweis tut von: Daniel
Geschrieben am: 22.12.2009 21:10:45

Hi
das was du da machst, ist doch nichts anderes als die SVERWEIS-Funktion, warum dann also ein Makro schreiben?
im einfachsten Fall sieht die Formel so aus:
(geschrieben für Tabelle1!C4)

= SVerweis(A4;DB!A:C;3;0)

sollte das wegen der Datenmenge Performance-Probleme geben, könntest du die Formel folgendermassen abändnern, allerdings muss dann die Tabelle DB nach Spalte A sortiert sein:

= Wenn(SVerweis(A4;DB!$A$4:$C$15000;1;1)=A4;SVerweis;(DB!$A$4:$C$15000;3;1);"")

als Makro würde das dann so aussehen:

Sub Go
dim Z as long, zDB as long
Z = sheets("Tabelle1").Cells(Rows.count,1).end(xlup).row
zDB = Sheets("DB").Cells(Rows.count,1).end(xlup).row
with Sheets("DB")
   .Range("4:" & zDB).sort key1:=.Cells(4,1), order1:=xlascending, Header:=xlno
end with
with Sheets("Tabelle1").Range("C4:C" & Z)
 .formulaR1C1 = _
 "=If(VLookUP(RC1,DB!R4C1:R" & zDB & "C1,1,1)=RC1,VLookUP(RC1,DB!R4C1:R" & zDB & "C3,3,1),"""")
 .formula = .value
end with
end sub
Gruß, Daniel
ps wie hast du dein Makro bei dir ans laufen gebracht? "Go" ist als Makroname nicht zulässig


  

Betrifft: Die Idee mit der Formel ist gut! Danke. von: edie
Geschrieben am: 22.12.2009 22:40:11

Hallo Daniel,

prima, die Idee mit Formel ist gut. Funktioniert auch Blitzschnell.

Danke, vielen Danke.

PS: Das Makro mit "Go" funktioniert bei mir, aber Danke für den Hinweis,
Sicherheitshalber kommt ein anderer Befehl.