VBA vs Formel

[snb]

Code:

Sub M_snb()
   sn = Tabelle1.ListObjects("Tabelle24").DataBodyRange
   sp = Tabelle2.ListObjects("Tabelle1").DataBodyRange
   
   For j = 1 To UBound(sn)
      sn(j, 46) = "n.d."
      sn(j, 47) = "n.d."
      If IsDate(sn(j, 20)) Then
         sn(j, 46) = Format(sn(j, 20), "yyyy/mm")
         sn(j, 47) = Format(sn(j, 20), "q")
      End If

      For jj = 1 To UBound(sp)
         If sp(jj, 1) = sn(j, 1) Then Exit For
      Next
      sn(j, 45) = "n.d."
      If jj <= UBound(sp) Then sn(j, 45) = sp(jj, 2)
  Next
End Sub

[snb]

Code:

Sub M_snb()
   sn = Tabelle1.ListObjects("Tabelle24").DataBodyRange
   sp = Tabelle2.ListObjects("Tabelle1").DataBodyRange
   
   For j = 1 To UBound(sn)
      sn(j, 46) = "n.d."
      sn(j, 47) = "n.d."
      If IsDate(sn(j, 20)) Then
         sn(j, 46) = Format(sn(j, 20), "yyyy/mm")
         sn(j, 47) = Format(sn(j, 20), "q")
      End If

      For jj = 1 To UBound(sp)
         If sp(jj, 1) = sn(j, 1) Then Exit For
      Next
      sn(j, 45) = "n.d."
      If jj <= UBound(sp) Then sn(j, 45) = sp(jj, 2)
  Next

  Tabelle1.ListObjects("Tabelle24").DataBodyRange=sn
End Sub

[Rabe]

Hallo André,

danke, nun habe ich es mit ein paar Anpassungen hinbekommen.

Hier das Makro:

Code:

Option Explicit
' ---------------------------------------------------------
'Deklaration der API-Funktion
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Werte_eintragen()
  '45,5 Sekunden
  Dim loStartTime As Long, i, Kunde$, Ergebnis, KundenTyp$, arrKunde, arrTyp
  Dim arrSend, arrLief_JM, arrLief_Q
  Dim arrAL, arrAV, arrAW
  loStartTime = GetTickCount
 
  'fuer ersten Teil
  arrKunde = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(8)   'H
  arrTyp = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(45)    'AS
  'fuer zweiten Teil
  arrSend = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(20) 'T
  arrLief_JM = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(46) 'AT
  arrLief_Q = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(47) 'AU
  'fuer dritten Teil
  arrAL = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns("A:L") 'A:L
  arrAV = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(48) 'AV
  arrAW = Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(49) 'AW
 
  'Ermittle Kunde und Kundentyp
  For i = 74 To UBound(arrKunde)   '2 Kopfzeilen nicht mitrechnen
     Kunde = arrKunde(i, 1)
     Ergebnis = Application.Match(Kunde, Tabelle2.ListObjects("Tabelle1").DataBodyRange.Columns(1), 0)
     '  Set Ergebnis = Columns(1).Find(what:=Kunde, LookAt:=xlWhole)
     If IsError(Ergebnis) Then
        KundenTyp = "n.d."
     Else
        KundenTyp = Tabelle2.ListObjects("Tabelle1").DataBodyRange.Columns(2).Cells(Ergebnis, 1)   'Blatt Listen3
     End If
     arrTyp(i, 1) = KundenTyp
     '   Next
     
     'Datum geliefert:
     If IsDate(arrSend(i, 1)) Then
        'Jahr/Monat eintragen
        arrLief_JM(i, 1) = Format(arrSend(i, 1), "yyyy") & "/" & Format(arrSend(i, 1), "mm")
        'Jahr/Quartal eintragen
        arrLief_Q(i, 1) = Format(arrSend(i, 1), "yyyy") & "/" & (-Int(-Month(arrSend(i, 1)) / 3))
     Else
        arrLief_JM(i, 1) = "n.d."
        arrLief_Q(i, 1) = "n.d."
     End If
     
     'Suchhilfe
     arrAV(i, 1) = arrAL(i, 9) & " " & arrAL(i, 10) & " " & arrAL(i, 12)
     'Suchhilfe Seriennummer
     If year(arrAL(i, 7)) < 2001 Then
        arrAW(i, 1) = "'" & Format(arrAL(i, 6), "000") & Format(arrAL(i, 7), "mm") & Right(arrAL(i, 1), 1)
     Else
        arrAW(i, 1) = "'" & Format(arrAL(i, 6), "0000") & Format(arrAL(i, 7), "mm") & Format(arrAL(i, 7), "yy")
     End If
  Next
  Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(45) = arrTyp
  Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(46) = arrLief_JM
  Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(47) = arrLief_Q
  Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(48) = arrAV
  Tabelle1.ListObjects("Tabelle24").DataBodyRange.Columns(49) = arrAW
 
  MsgBox "Laufzeit " & _
      (GetTickCount - loStartTime) / 1000 & " SeKunden.", _
      vbInformation, " SeKunden"
End Sub

Diese Zeile bereitet noch Probleme:
        arrAW(i, 1) = "'" & Format(arrAL(i, 6), "000") & Format(arrAL(i, 7), "mm") & Right(arrAL(i, 1), 1)

Es wird keine Zahl (letzte Ziffer der Jahreszahl) aus der Spalte A extrahiert für 1998-2000.

  Bestellung Test - V2.xlsb (Größe: 683,88 KB / Downloads: 3)

PS: Ich hatte die Nachricht schon gestern abend geschrieben, aber daann vergessen abzuschicken.

[schauan]

Hallo Ralf,

Ich übernehme komplette Spalten aus dem DataBodyRange.
Deine Schleife beginnt aber erst bei "74" - ich weiß nicht, wieso - und dort beginnt 2001
Die älteren Jahre bekommst Du, wenn Du die Schleife bei 1 beginnst.

[Rabe]

Hi Andrè,

ja das ist klar, aber dann stoppt das Makro in der Zeile

Code:

arrAW(i, 1) = "'" & Format(arrAL(i, 6), "000") & Format(arrAL(i, 7), "mm") & Right(arrAL(i, 1), 1)

mit Laufzeitfehler 13 Typen unverträglich

Siehe Anhang des letzten Beitrags.
Dort das Makro so ändern, daß for 1 to ubound... steht und dieses Makro dem Button zuweisen.

[schauan]

Hallo Ralf,

das liegt an dem Fehler in F3 Da musst Du schauen, wie Du den wegbekommst.

[Rabe]

Hi André,

danke. Ich habe die Formel komplett entfernt und durch die Werte ersetzt. Ich habe das ja nur gebraucht, weil ich die Originalzahlen in meiner Musterdatei nicht habe. Dann konnte ich da auch 0001 eintragen.

Nun läuft das Makro durch und benötigt 47,5 Sekunden.

Jörg sagt ja, das geht auch alles mit PQ viel einfacher und schneller.
Das ist nun der nächste Versuch, das mit PQ zu machen:

1. Zusammenziehen der ganzen Jahresblätter in das Blatt alle
   
2. Ausfüllen der Spalten AS-AW
   

[snb]

Warum ignorierst du http://www.clever-excel-forum.de/thread-...#pid113978 ?

[Rabe]

Hi,

ich wollte die anderen Makros zuerst fertig machen.
Ich habe inzwischen auch die Originaldatei bekommen und versuchte es auch damit.


Nun teste ich aber Dein Makro!
Ergebnis folgt.

PS:
Außerdem habe ich die Influenza und bin nicht ganz klar im Kopf!

[Jockel]

Hi,

... habe ich die Influenza und bin nicht ganz klar im Kopf!

Hallöchen, bist du also ein Influencer ..? Gute Besserung...