Thema Datum  Von Nutzer Rating
Antwort
30.08.2017 16:03:20 Lutz
NotSolved
30.08.2017 16:38:55 Mackie
NotSolved
Rot Tabelle Sortieren
 30.08.2017 17:44:55 Gast70117
NotSolved
30.08.2017 18:09:50 Gast70117
NotSolved
05.09.2017 08:41:46 Gast44156
NotSolved

Ansicht des Beitrags:
Von:
Gast70117		 Datum:
30.08.2017 17:44:55		 Views:
640		 Rating:
     
Antwort:
  Ja
Thema:
Tabelle Sortieren

hm... einfach und geschmacklos lt. dem Beispiel

Option Explicit

Sub Tab1To2()
'aktive Mappe hat 2 Tabellen - hier "Tabelle1", "Tabelle2"
Dim rngU As Range, x As Long
Dim arrB() As Variant, rngZ As Range

   '2. leeren
   Sheets("Tabelle2").Cells.Clear
   'brutal
   Sheets("Tabelle1").Cells.Copy Sheets("Tabelle2").Cells(1)
   

   With Sheets("Tabelle2")
      Set rngU = .UsedRange
      'wir haben Kopfzeilen
      Set rngU = rngU.Offset(1).Resize(rngU.Rows.Count - 1)
      'Spalten verdichten
      arrB = GetDistinct(rngU)
      'ausgeben Unikate
      Set rngZ = .Cells(1, rngU.Columns.Count + 2)
      rngZ.Value = "Fall"
      rngZ.Offset(, 1).Value = "Anzahl"
      rngZ.Offset(1).Resize(UBound(arrB), 1).Value = Application.Transpose(arrB)
      'zählen und ausgeben Unikate
      For x = LBound(arrB) To UBound(arrB)
         If arrB(x) <> "" Then
            rngZ.Offset(x + 1, 1).Value = WorksheetFunction.CountIf(rngU, arrB(x))
         End If
      Next x
      .Columns.AutoFit
   End With

End Sub

''
Private Function GetDistinct(ByVal oTarget As Range) As Variant
''Zweck Dupplikate in gegebenen Bereich entfernen, als Array
''posted by Craig Hatmaker
Dim varArray As Variant
Dim objMyDic As Object
Dim V        As Variant
'
  Set objMyDic = CreateObject("Scripting.Dictionary")
  varArray = oTarget
  For Each V In varArray
    objMyDic(V) = V
  Next
  GetDistinct = objMyDic.Items()
End Function

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
30.08.2017 16:03:20 Lutz
NotSolved
30.08.2017 16:38:55 Mackie
NotSolved
Rot Tabelle Sortieren
 30.08.2017 17:44:55 Gast70117
NotSolved
30.08.2017 18:09:50 Gast70117
NotSolved
05.09.2017 08:41:46 Gast44156
NotSolved