Ausgefüllte Zellen aus Matrix auswählen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Nils
Schau mal ob du das angepasst bekommst:

Option Explicit

Public Sub machs()
    Dim die_Matrix As Variant
    Dim objAl As Object
    Dim out As Variant
    Dim L As Long
    Dim I As Integer
    Set objAl = CreateObject("System.Collections.Arraylist")
    die_Matrix = Sheets("Tabelle1").Range("A1:D8") 'anpassen
    With objAl
        For L = 1 To UBound(die_Matrix)
            For I = 1 To UBound(die_Matrix, 2)
                If die_Matrix(L, I) <> "" Then .Add die_Matrix(L, I) 'Einlesen
            Next
        Next
        .Sort 'Sortieren
        out = .toArray
    End With
    'Ausgeben
    Sheets("Tabelle1").Range("A10").Resize(1, 10) = out 'Anpassen
End Sub

ransi

Hallo Nils,
Bereiche ggf. anpassen!

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

Option Explicit

Sub sortMatrix()
  Dim vntList As Variant
  
  With ActiveSheet
    vntList = UniqueList(.Range("A1:D8"))
    .Range("A10") = Join(vntList, " ")
  End With
  
End Sub


Private Function UniqueList(Matrix As Range, Optional VisibleCellsOnly As Boolean = True, Optional IncludeNull As Boolean = True, Optional Sorted As Boolean = True) As Variant
  Dim objDic As Object, rng As Range, varTmp() As Variant, vntExclude As Variant
  
  Set objDic = CreateObject("Scripting.Dictionary")
  
  vntExclude = IIf(IncludeNull, "", 0)
  
  If VisibleCellsOnly Then Set Matrix = Matrix.SpecialCells(xlCellTypeVisible)
  
  For Each rng In Matrix.Cells
    If rng.Value <> vntExclude Then objDic(rng.Value) = 0
  Next
  
  varTmp = objDic.keys
  
  If Sorted Then QuickSort varTmp
  
  UniqueList = varTmp
  
  Set objDic = Nothing
End Function


Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Ausgefüllte Zellen aus Matrix auswählen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ausgefüllte Zellen aus Matrix auswählen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread