Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro zickt
#11

.xlsm   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
Antworten Top
#12
vielleicht hilft dir das weiter.

https://www.herber.de/forum/archiv/788to...siert.html
Antworten Top
#13
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
Antworten Top
#14
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
Antworten Top
#15
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
Antworten Top
#16
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 RangesOutlk As Stringrg 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:=1Header:=xlNo
    Range
("B5").Activate
    
  
For Each SB In Range(Range("IV1"), Range("IV1").End(xlDown)).Cells
    Range
("A4").AutoFilter Field:=1Criteria1:="=" SB.ValueOperator:=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(001'Pause zum anschauen am Bildschirm
 
  Next
  
Range("A4").AutoFilter Field:=1
End Sub 
Antworten Top
#17
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
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • ari-2001
Antworten Top
#18
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
Antworten Top
#19
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. Wink Notwendig ist es vermutlich nicht.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • ari-2001
Antworten Top
#20
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
[-] Folgende(r) 1 Nutzer sagt Danke an Elex für diesen Beitrag:
  • ari-2001
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste