Office-Fragen.de

Hallo

kann man das aussortieren der doppelten in Tabelle Daten auch über mehere Tabellenblätter machen.

Habe das in Tabelle Daten mit einer Martix hinbekommen. Nur müsste es doch auch mit mehreren Tabellenblättern funktionieren.

Eine VBA Lösung wäre auch nicht schlecht.

Gruß
Chris

Hallo Chris,
eine VBA-Lösung wäre

Code:
Sub MaxMin()

Const Zielblatt = "Daten" 'ggfls. anpassen

Const Wertspalte = 3

Dim Ziel As Object, sh As Object, Werte() As Variant

Dim zeile As Long, Wert As String, erg As Variant

Dim ErsteZeile As String, ErgWert As Long, i As Long, anz As Long

  Set Ziel = ThisWorkbook.Sheets(Zielblatt)

  ReDim Werte(1 To 2, 1 To 1)

  For Each sh In ThisWorkbook.Sheets

    With sh 'vorhandene Werte ermitteln

      zeile = 3

      Do

        Wert = .Cells(zeile, Wertspalte)

        If Wert = "" Then Exit Do

        erg = True

        For i = 1 To UBound(Werte, 2)

          If Wert = Werte(1, i) Then

            erg = False

            Exit For

          End If

        Next i

        If erg Then 'Wert in Array einfügen

          anz = anz + 1

          ReDim Preserve Werte(1 To 2, 1 To anz)

          Werte(1, anz) = Wert

        End If

        zeile = zeile + 1

      Loop

    End With

  Next sh

  For i = 1 To UBound(Werte, 2) 'Maxima ermitteln

    anz = 0

    For Each sh In ThisWorkbook.Sheets

      With sh

        Set erg = sh.Columns(Wertspalte).Find(What:=Werte(1, i), Lookat:=xlWhole)

        If Not erg Is Nothing Then

          ErsteZeile = erg.Row

          Do

            anz = anz + 1

            Werte(2, i) = WorksheetFunction.Max(Val(Werte(2, i)), Val(sh.Cells(erg.Row, 5)))

            Set erg = .Columns(Wertspalte).FindNext(erg)

          Loop Until erg.Row = ErsteZeile

        End If

      End With

    Next sh

    With Ziel

      Set erg = .Columns(Wertspalte).Find(What:=Werte(1, i), Lookat:=xlWhole)

      If Not erg Is Nothing Then

        .Cells(erg.Row, 6) = IIf(anz = 1, 2, Werte(2, i))

      Else

        MsgBox "Wert " & Werte(1, i) & " nicht auf Blatt " & Zielblatt & " vorhanden"

      End If

    End With

  Next i

End Sub

Hallo,

super danke schön.

Habs gerade auspropiert.

Funktioniert bis auf das wenn in der Spalten C im Tabellenblatt Daten keine Doppelten gefunden werden dort ein Spalte F eine 2 Geschrieben wird da sollte eher nichts stehen .

Könnte man das ganze auch ohne das Tabellenblatt Daten machen . Also wie hier mit Tabellenblatt A,B, u.s.w in Spalte F den MAX Wert anzeigen lassen und wenn keine Doppelten gefunden werden Zelle leer lassen.

Wenn du mir da nochmal helfen könntest.

Gruss
Chris

Chris1972

AlterDresdner

Chris1972