VBA vs Formel

[Rabe]

Hi,

mit diesem Makro fülle ich Inhalte in bestimmte Zellen:

Code:

  With Worksheets("Alle")
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
     
     For i = loZeileNeu To loLetzte
        'Ermittle Kunde und Kundentyp
        Kunde = .Range("H" & i)
        Set Ergebnis = Worksheets("Listen3").Columns(1).Find(what:=Kunde, LookAt:=xlWhole)
        If Ergebnis Is Nothing Then
           Kundentyp = "n.d."
        Else
           Kundentyp = Worksheets("Listen3").Range("B" & Ergebnis.Row)    'Blatt Listen3
        End If
        .Range("AS" & i) = Kundentyp
       
        'Datum geliefert: Jahr/Monat eintragen
        If IsDate(.Range("T" & i)) Then .Range("AT" & i) = Format(.Range("T" & i), "yyyy") & "/" & Format(.Range("T" & i), "mm") Else .Range("AT" & i) = "n.d."
        'Datum geliefert: Jahr/Quartal eintragen
        If IsDate(.Range("T" & i)) Then .Range("AU" & i) = Format(.Range("T" & i), "yyyy") & "/" & (-Int(-Month(.Range("T" & i)) / 3)) Else .Range("AU" & i) = "n.d."
       
        'Suchhilfe
        .Range("AV" & i) = .Range("I" & i) & " " & .Range("J" & i) & " " & .Range("L" & i)
       
        'Suchhilfe Seriennummer
        If year(.Cells(i, 7)) < 2001 Then
           .Range("AW" & i) = "'" & Format(.Range("F" & i), "000") & Format(.Range("G" & i), "mm") & Right(.Range("A" & i), 1)
        Else
           .Range("AW" & i) = "'" & Format(.Range("F" & i), "0000") & Format(.Range("G" & i), "mm") & Format(.Range("G" & i), "yy")
        End If
     Next i
     
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
     With .Range("A" & loZeileNeu & ":AX" & loLetzte).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With
  End With

da das Makro seeehr lange läuft (wie stoppe ich per VBA die Zeit?), will ich versuchen, das mit Formeln über eine intelligente Tabelle zu erschlagen, aber ich weiß gerade nicht, wie ich das Quartal rausbekomme und die Ergebnisse sind anders, als erwartet:

Arbeitsblatt mit dem Namen 'Alle'
	T	U	AS	AT	AU
2	verschickt am	Software ini	Kundentyp	Geliefert Monat	Geliefert Quartal
14411	14.01.2015			2015/01	2015/1
14412	14.01.2015			2015/01	2015/1
14413	03.03.2015			2015/01	2015/1
14414	03.03.2015			2015/01	2015/1

Zelle	Format	Wert
T2	TT.MM.JJJJ	verschickt am
AT2	[$-407]MMM. JJ;@	Geliefert Monat
T14411	TT.MM.JJJJ	14.01.2015
U14411	TT.MM.JJJJ
T14412	TT.MM.JJJJ	14.01.2015
U14412	TT.MM.JJJJ
T14413	TT.MM.JJJJ	03.03.2015
U14413	TT.MM.JJJJ
T14414	TT.MM.JJJJ	03.03.2015
U14414	TT.MM.JJJJ

Zelle	Formel
AT14411	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&TEXT(MONAT([@[verschickt am]]);"MM");"n.d.")
AU14411	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&(GANZZAHL(TEXT(MONAT([@[verschickt am]]);"MM")/3)+1);"n.d.")
AT14412	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&TEXT(MONAT([@[verschickt am]]);"MM");"n.d.")
AU14412	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&(GANZZAHL(TEXT(MONAT([@[verschickt am]]);"MM")/3)+1);"n.d.")
AT14413	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&TEXT(MONAT([@[verschickt am]]);"MM");"n.d.")
AU14413	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&(GANZZAHL(TEXT(MONAT([@[verschickt am]]);"MM")/3)+1);"n.d.")
AT14414	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&TEXT(MONAT([@[verschickt am]]);"MM");"n.d.")
AU14414	=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&(GANZZAHL(TEXT(MONAT([@[verschickt am]]);"MM")/3)+1);"n.d.")

Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2013

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

[WillWissen]

Hi Ralf,

meinst du so?

Arbeitsblatt mit dem Namen 'Tabelle3'
	A	B	C	D
1		Jahr/Monat		Jahr/Quartal
2	14.01.2018	2018/01	14.01.2018	2018/01
3	15.02.2018	2018/02	15.04.2018	2018/02
4	16.03.2018	2018/03	16.11.2018	2018/04

Zelle	Formel
B2	=TEXT(JAHR(A2);"0000")&"/"&TEXT(MONAT(A2);"00")
D2	=TEXT(JAHR(C2);"0000")&"/"&TEXT(AUFRUNDEN(MONAT(C2)/3;0);"00")

Verwendete Systemkomponenten: [Windows (32-bit) NT :.00] MS Excel 2013

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

[BoskoBiati]

Hi Ralph,

für das Quartal geht das so:

Code:

=WENN(ISTZAHL([@[verschickt am]]);JAHR([@[verschickt am]])&"/"&MONAT(MONAT([@[verschickt am]])&0);"")

[RPP63]

da das Makro seeehr lange läuft (wie stoppe ich per VBA die Zeit?), will ich versuchen, das mit Formeln über eine intelligente Tabelle zu erschlagen, aber ich weiß gerade nicht, wie ich das Quartal rausbekomme

Moin!

• Quartal: DatePart("q", Date)
  
• Zeit: Double-Variable Start = Timer
  
• Laufzeit: Debug.Print Timer - Start
  

Gruß Ralf

[BoskoBiati]

Hi,

am VBA-Code könnte man noch rumschrauben, aber nicht testen. wie wäre es mit einer Dummy-Datei?

Ich würde die Abfragen etwas umgestalten:

Code:

If Not IsDate(.Range("T" & i)) Then
   .Range(.Cells(i, "AT"), .Cells(i, "AU")) = "n.d."
Else
        .Range("AT" & i) = Format(.Range("T" & i), "yyyy") & "/" & Format(.Range("T" & i), "MM")
        'Datum geliefert: Jahr/Quartal eintragen
        .Range("AU" & i) = Format(.Range("T" & i), "yyyy") & "/" & Format((Int(Month(.Range("T" & i)) / 3)), "MM")
 End If

[schauan]

Hallo Ralf,
Bei mir auf www.xltips.de hab ich was zum Zeit stoppen. Ich mach das per API, mit gettickcount. Bin aber gerade am Smartphone, daher nicht genauer.

[RPP63]

Moin André!
Ich nehme, wenn es auf große Genauigkeit ankommt auch gettickcount:
Modul Micro_timer

Option Explicit 
 
#If VBA7 Then 
  Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
    "QueryPerformanceFrequency" (cyFrequency As Currency) As Long 
  Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
    "QueryPerformanceCounter" (cyTickCount As Currency) As Long 
#Else 
  Private Declare Function getFrequency Lib "kernel32" Alias _
    "QueryPerformanceFrequency" (cyFrequency As Currency) As Long 
  Private Declare Function getTickCount Lib "kernel32" Alias _
    "QueryPerformanceCounter" (cyTickCount As Currency) As Long 
#End If 
 
Public Function Microtimer() As Double 
Dim cyTicks1 As Currency 
Static cyFrequency As Currency 
  Microtimer = 0 
  If cyFrequency = 0 Then getFrequency cyFrequency 
  getTickCount cyTicks1 
  If cyFrequency Then Microtimer = cyTicks1 / cyFrequency 
End Function 
 

Wir haben gerade 610732,126624703

Gruß Ralf

[snb]

Wenn du Arrays verwendest ist ein Timer überflüssig.

Ich warte mal deine Beispeildatei ab. (cfr. Hajo_Zi)

[Rabe]

Hi,

ich werde nächste Woche eine Beispieldatei erzeugen, bin aber bis Mittwoch auf Dienstreise.

Ich hoffe, ich finde das Thema dann wieder, aber danke schon mal für die Vorschläge, die Formeln funktionieren sehr gut mit meinem Ausschnitt.

[Rabe]

Hi,

hier nun endlich die Beispieldatei:

  Bestellung Test.xlsb (Größe: 416 KB / Downloads: 13)