Office: (Office 2016) Bestimmte Zellwerte aus Zählenwenn in Liste schreiben

Hallo,

Ich habe aus einem (nicht veränderbaren) externen Import (Register 'Import') verschiedene Daten, die ich mir über verschiedene Zählenwenns-Bedingungen aufschlüssele (Register 'Übersicht').

Nun hätte ich gerne gehabt, das wenn ich auf die Zelle eines gezählten Ergebnisses klicke, mir bestimmte Zellwerte entsprechend den gezählten Daten rechts als Liste erscheinen.

Bspw. wenn ich im Beispiel auf B8 klicke, soll es rechts so ausgefüllt werden.
Zudem soll es performancemäßig auch mit bis zu 10000 Datensätzen noch klar kommen.

Wie ist sowas am besten machbar?

Danke und Gruß
Matthias

 

Hallo,

Ich habe meinen Wunsch derzeit mit der geänderten Test1.xlsx wie folgt realisiert.
In Tabelle1 (Übersicht):

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column = 2 And Target.Row = 8 Then
Sheets("Übersicht").Range("F7:H65536").ClearContents
   For Zeile = 1 To Sheets("Zwischen").Range("A65536").End(xlUp).Row
      If Sheets("Zwischen").Cells(Zeile, 3) >= 7 And Sheets("Zwischen").Cells(Zeile, 3) < 14 And Sheets("IMPORT").Cells(Zeile, 6) = "Norm" Then
         
         Sheets("IMPORT").Cells(Zeile, 2).Copy
         If Sheets("Übersicht").Range("F7") = "" Then
            Sheets("Übersicht").Range("F7").PasteSpecial Paste:=xlPasteValues
         Else
            Sheets("Übersicht").Range("F65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
         End If
         
         Sheets("IMPORT").Cells(Zeile, 1).Copy
         If Sheets("Übersicht").Range("G7") = "" Then
            Sheets("Übersicht").Range("G7").PasteSpecial Paste:=xlPasteValues
         Else
            Sheets("Übersicht").Range("G65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
         End If
         
         Sheets("IMPORT").Cells(Zeile, 3).Copy
         If Sheets("Übersicht").Range("H7") = "" Then
            Sheets("Übersicht").Range("H7").PasteSpecial Paste:=xlPasteValues
         Else
            Sheets("Übersicht").Range("H65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
         End If
                  
       End If
      
   Next 'Zeile
   End If
End Sub

Allerdings nur für Zelle B8.
Wie kann ich das jetzt für weitere Zellen fortführen, ohne das der Code zu lang wird?
Bei den Bereichen ist es nämlich möglich, das noch welche hinzukommen.

Oder ist der Ansatz grundverkehrt?

Danke und Gruß
Matthias

 

Hallo,

hier mal ein unfertiger Ansatz, der mit einem Doppelklick auf eine Zelle in der Übersicht funktioniert. Störend ist momentan noch die Tatsache, dass da Formeln stehen. Habe aber momentan keine Zeit, das noch auszubauen.

Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleclick(ByVal Target As Range, cancel As Boolean)
Dim loBeginn As Long
Dim loEnde
Dim loLetzte As Long
Dim strBereich As String
Dim loZeile As Long
Dim loZeile2 As Long
  If Intersect(Target, Range("B7:D16")) Is Nothing Or Target.Count > 1 Then Exit Sub
Sheets("Übersicht").Range("F7:H65536").ClearContents
loLetzte = Sheets("Import").Range("A65536").End(xlUp).Row
strBereich = Cells(6, Target.Column)
loZeile2 = 7
Select Case Target.Row
    Case 7
        loBeginn = 0
        loEnde = 7
    Case 8
        loBeginn = 8
        loEnde = 14
    Case 9
        loBeginn = 15
        loEnde = 30
    Case 10
        loBeginn = 31
        loEnde = 60
    Case 11
        loBeginn = 61
        loEnde = 90
    Case 12
        loBeginn = 91
        loEnde = 365
    Case 13
        loBeginn = 366
        loEnde = 730
    Case 14
        loBeginn = 731
        loEnde = 7
    Case 15
        loBeginn = 0
        loEnde = 1095
    Case 16
        loBeginn = 0
        loEnde = 0
    End Select
With Sheets("Import")
    If loEnde <> 0 Then loEnde = Range("B3") + loEnde
        
   For loZeile = 1 To loLetzte
   
      If (.Cells(loZeile, 4) = Range("B3")) And (.Cells(loZeile, 6) = strBereich) And (.Cells(loZeile, 5) >= Range("B3") + loBeginn) And (.Cells(loZeile, 5) < loEnde) Then
        Sheets("Übersicht").Cells(loZeile2, 6) = .Cells(loZeile, 2)
        Sheets("Übersicht").Cells(loZeile2, 7) = .Cells(loZeile, 1)
        Sheets("Übersicht").Cells(loZeile2, 8) = .Cells(loZeile, 3)
        loZeile2 = loZeile2 + 1
        End If
    Next
 End With
         
         
End Sub

 

Hallo,

hier mal eine Datei. Mit der Eingabe eines Datums in der Übersicht, B3 wird die Tabelle ausgefüllt. Mit Doppelklick auf irgendeine Zelle in der Tabelle wird die zugehörige Liste ausgegeben. Nur Deine Berechnung der Zeiten habe ich jetzt nicht geändert, die ist aber so nicht korrekt!


Den Anhang Tischbelegung_2.xlsb betrachten

 

Hallo Edgar,

Ja, so entspricht es meinen Vorstellungen!
Vielen Dank deiner Mühe!

Wegen der nicht korrekten Zeitberechnung, meinst du, weil einmal Tag und dann Monat (das können ja auch nur 28 Tage sein)?
Eigentlich kommen am Ende nur Tag-Zeitspannen hin, so wie es berechnet war/ist.
Oder ist da noch was faul?

Also ich schau mir es dann nochmal genauer an, aber ich denke, das passt prima!

Tolle Umsetzung!

Gruß Matthias

 

Hallo,

3 Monate z.B. sind zwischen 89 und 92 Tage, 1 Monat zw. 28 u. 31 Tage.

Ich hätte auch noch eine Sortierfunktion für die Liste in F:H!

 

Hallo,

So, nun hab ich es noch erweitert und angepasst, klappt super!
Tausend Dank!

Ja, das mit dem Monat ist klar, meinte ja auch, die korrekten Bezeichner heißen eigentlich bspw. "31 bis 60 Tage" usw.

Eine Sortierfunktion wäre natürlich nochmal ein tolles Extra für die Ergebnisliste.
Möglichst dann aber für 2 Spalten, da Werte manchmal gleich sein können.
Im Beispiel wäre in erster Linie die Sortierung in G aufsteigend und in zweiter Sortierung H absteigend interessant, wenn du es schon so anbietest :-)

Ich wünsche auf jeden Fall einen guten Rutsch nach 2017

Gruß Matthias

 

Hallo,

hier:

Den Anhang Tischbelegung_2.xlsb betrachten

 

Hallo Edgar,

Danke dir, aber bei mir sortiert es hier nichts :-(

Habe mal manuell den Import "durcheinander" gebracht, so das man es besser sehen konnte.

Nachtrag: Gefunden.. ELSE sollte vor der Zählanweisung eigentlich weg, oder?

Gruß Matthias

 

Hallo,

es kommt darauf an. Ich hatte es so konzipiert, das man die Überschrift anklickt und dann wird sortiert.