Makro zickt

[ari-2001]

  Mappe für CEF 2.xlsm (Größe: 60,07 KB / Downloads: 7) Hallo,

ich habe eine Tabelle, in der ich es jetzt endlich (vielen Dank an Elex) hinbekommen habe, nach Formelwerten usw. zu filtern, auch mit Datumswerten, um das auszudrucken, bzw. an eine andere Datei zu übergeben.

Leider aktualisieren sich während des Ausführens des Makros "Übersicht Sub erstellen" die Funktionen in "P129" und "Q129" nicht.

Das Makro ist in der Übersicht enthalten,
die Funktion "outlookeintrag" ist folgende:

Private Function Outlookeintrag(xRg As Variant, sptChar As String)

    Dim rg As Range
    For Each rg In xRg
        If (rg.EntireRow.Hidden = False) And (rg.EntireColumn.Hidden = False) Then
            Outlookeintrag = Outlookeintrag & rg.Value & sptChar
        End If
    Next
    Outlookeintrag = Left(Outlookeintrag, Len(Outlookeintrag) - Len(sptChar))
End Function


Wie bekomme ich das Makro dazu, die Funktion "outlookeintrag" beim durchlaufen mit zu aktivieren, damit bei den gefilterten Ergebnisse sind in den genannten Bereichen
die Funktion aktualisiert?

Ich bekomme es so grade nicht auf die Reihe.

Bei der Gelegenheit, ich habe eine Indexformel in L1, die lautet:
INDEX(K:K;MIN(WENN(TEILERGEBNIS(3;INDIREKT("K"&ZEILE(5:128)))*ZEILE(5:128)>0;TEILERGEBNIS(3;INDIREKT("K"&ZEILE(5:128)))*ZEILE(5:128))))
und sucht mir, wenn ich etwas filter, den richtigen Wert aus der Reihe "K".

Die Formel benutze ich schon seit Ewigkeiten, gibt es da mittlerweile was moderneres für?

Ich bedanke mich schon jetzt im Voraus für die Hilfe.

Viele Grüße
Andreas

[ralf_b]

vielleicht hilft dir das weiter.

https://www.herber.de/forum/archiv/788to...siert.html

[ari-2001]

Hallo Ralf,

ich blicke da nicht mehr durch.
Ich habe da jetzt stundenlang beigesessen, ich bekomme es nicht hin, dass beim Filtern die Werte aktualisiert werden.

Ich habe auch keine Ahnung mehr, wie ich es schaffe.

Gruß
Andreas

[Elex]

Hi

Wenn mann nicht nur Teileinblicke in dein Vorhaben hätte wäre mein Vorschlag evtl. ein anderer.
Aber Versuch es mal so.

Code:

Sub SortierenMitFormelspalte()
Dim SB, rng As Range, n As String
   
    Columns("IV").Clear
    Range(Range("a5"), Range("A5").End(xlDown)).Copy
    Range("IV1").PasteSpecial (xlPasteValuesAndNumberFormats)
   
    Range(Range("IV1"), Range("IV1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B5").Activate
    With ActiveSheet.ListObjects("Tabelle13")
      Set rng = Application.Intersect(.TotalsRowRange, .ListColumns("Outlook 1").Range)
      n = "=outlookeintrag(R[-" & .TotalsRowRange.Row - 5 & "]C:R[-1]C,"" //  "")"
   
      For Each SB In Range(Range("IV1"), Range("IV1").End(xlDown)).Cells
        Range("A4").AutoFilter Field:=1, Criteria1:="=" & SB.Value, Operator:=xlAnd
        rng.Resize(1, 2).FormulaR1C1 = n
      'ActiveSheet.PrintOut
      Next
    End With
   
    Range("A4").AutoFilter Field:=1
    rng.Resize(1, 2).FormulaR1C1 = n
    Set rng = Nothing
End Sub

Gruß Elex

[ari-2001]

Hallo Elex,

ich möchte nur, dass das Makro in Spalte "A" jedes Datum filtert.

Outlook 1 und Outlook 2 liefern mir hinterher (zumindest geht es bei manueller Filterung so)

die benötigten Einträge für unseren Outlook-Kalender.

Die Outlookeinträge werden mit einem anderem Makro (das ist in der richtigen Version bereits enthalten" in eine andere Tabelle kopiert.
Diese hieraus erstellte Liste wiederum wird durch ein anderes Makro in den Outlook-Kalender eingetragen, so dass dort später z.B. steht:

21.04.2020 Donnerstag  Theater 19:30 // F6 Bus 3 // F7 Bus 4 // F9 Bus 6 // F11 Bus 7 // F12 Bus 8
(in der richtigen Version steht dann anstelle z.B. Bus 3 ein Firmenname. Habe ich aus Datenschutzgründen entfernt und so halt fürs Forum abgespeckt.

Ich versuche es gleich mal, mit dem kopieren der Formel via VBA, wie Du es im letzten Beitrag geschrieben hast. Ich bin echt den Tränen nahe, dass es an so einem
Scheiss scheitert, weil ich zu doof bin, die Funktion auch beim autofilter zu aktualisieren.

Gruß
Andreas

[ralf_b]

Versuch mal das hier.   im mittleren Bereich habe ich mal deinen Outlooktext zusammengebastelt. Mir ist aufgefallen das du in deinen Zellen bereits Textverarbeitung mittels verketten usw. machst. Das könnte eigentlich alles per Makro passieren. Nur muß man dazu die genaue Dateistruktur kennen.  

PHP-Code:

Sub SortierenMitFormelspalte()
Dim SB
Dim rng As Range, sOutlk As String, rg As Range
Dim sptChar As String
sptChar = " // "
    Columns("IV").Clear
    Range(Range("a5"), Range("A5").End(xlDown)).Copy
    Range("IV1").PasteSpecial (xlPasteValuesAndNumberFormats)
   
    
    Range(Range("IV1"), Range("IV1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B5").Activate
    
  For Each SB In Range(Range("IV1"), Range("IV1").End(xlDown)).Cells
    Range("A4").AutoFilter Field:=1, Criteria1:="=" & SB.Value, Operator:=xlAnd ' wenn es kein Datum ist, Criteria1:= SB.value
    
    Set rng = ActiveSheet.Range("A5:R128").SpecialCells(xlCellTypeVisible)
    
      For Each rg In rng.Rows
     
        If rg.Row = rng.Row Then
            sOutlk = sOutlk & rng.Cells(1, 1).Value & sptChar
            sOutlk = sOutlk & Format(CDate(rng.Cells(1, 1)), "dddd") & sptChar
            sOutlk = sOutlk & rng.Cells(1, 16)
        End If
               
        sOutlk = sOutlk & rg.Cells(1, 17).Value & sptChar
                           
     Next
    
     sOutlk = Left(sOutlk, Len(sOutlk) - Len(sptChar))
    
   
    
    'ActiveSheet.PrintOut
    'Call PDF
    'ActiveSheet.ShowAllData
    
    Application.Wait Now + TimeSerial(0, 0, 1) 'Pause zum anschauen am Bildschirm
 
  Next
  
Range("A4").AutoFilter Field:=1
End Sub 


[Kuwer]

Hallo Andreas,

so sollte es klappen:

' **************************************************************
'  Modul:  Modul2  Typ = Allgemeines Modul
' **************************************************************

Private Function Outlookeintrag(xRg As Variant, sptChar As String)
    Dim rg As Range
    Application.Volatile
    For Each rg In xRg
        If (rg.EntireRow.Hidden = False) And (rg.EntireColumn.Hidden = False) Then
            Outlookeintrag = Outlookeintrag & rg.Value & sptChar
        End If
    Next
    Outlookeintrag = Left(Outlookeintrag, Len(Outlookeintrag) - Len(sptChar))
End Function

' **************************************************************
'  Modul:  Modul1  Typ = Allgemeines Modul
' **************************************************************

Option Explicit

Sub SortierenMitFormelspalte()
    Dim SB
    
    Columns("IV").Clear
    Range(Range("a5"), Range("A5").End(xlDown)).Copy
    Range("IV1").PasteSpecial (xlPasteValuesAndNumberFormats)
  
    
    Range(Range("IV1"), Range("IV1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    'Range("B5").Activate
    
  For Each SB In Range(Range("IV1"), Range("IV1").End(xlDown)).Cells
    Range("A4").AutoFilter Field:=1, Criteria1:="=" & SB.Value, Operator:=xlAnd ' wenn es kein Datum ist, Criteria1:= SB.value
    
    'ActiveSheet.PrintOut
    'Call PDF
    'ActiveSheet.ShowAllData
    
    ActiveSheet.Calculate
    Application.Wait Now + TimeSerial(0, 0, 1) 'Pause zum anschauen am Bildschirm

  Next
  
  Range("A4").AutoFilter Field:=1
  ActiveSheet.Calculate
End Sub

Gruß Uwe

[ari-2001]

Hallo Uwe,

ich verneige mich, bestens!

Auf die Idee, der Funktion zuzuweisen, dass sie neu berechnet wird (Application.Volatile) bin ich zwar auch gestoßen,
aber das "activeSheet.calculate" habe ich nicht auf dem Schirm gehabt.

Super, funzt!

Eine Frage,
das "''Range("B5").Activate"
hast Du deaktiviert, welchen Vor oder Nachteil hat das?

Ansonsten spitze, es erleichtert mir Unmengen von händischem kopieren.

Vielen lieben Dank,
Andreas

[Kuwer]

Hallo Andreas,

das "'Range("B5").Activate" hatte ich deaktiviert, damit die Zelle mit der Funktion beim Testen auf dem Bildschirm bleibt.
Ob das Sinn ergibt, B5 zu aktivieren, kannst ja nur Du wissen. Notwendig ist es vermutlich nicht.

Gruß Uwe

[Elex]

Hi

Das "'Range("B5").Activate" hatte ich aktiviert, um beim Testlauf auch wenn die Liste vorher gesrollt war das Filterergebnis zu sehen. Für einen Ausdruck kann es bestimmt weg.

Interessant ist das mit Application.Volatile.
Ich hatte in #9 schon ein Calculate eingebaut. Und im Einzelschritt wird dann auch in die Funktion gesprungen und durchlaufen. Liefert aber kein Ergebnis. Warum sie dann überhaupt durchlaufen wird?

Gruß Elex