doppelte werte nur einmal auslesn

hallo ;-)
ich habe zwei arbeitsmappen.... eine heißt daten (das tabellenblatt darin heißt auftrag) und die andere arbeismappe heißt übersicht....
in der arbeitsmappe daten stehen in spate E von e5 bis e200 werte die einmal aber auch z.b. 30 mal vorkommen können (also z.b. 20 verschiedene werte, die aber doppelt und dreifach vorhanden sind)
nun möchte ich gerne in der arbeitsmappe Übersicht ab zelle a5 die 20 verschiedenen werte sehen und ab zelle b5 wie oft der wert vorhanden ist.... also in spalte a jeden wert einmal und in spalte b dann die anzahl....
kann mir da jemand helfen? die anzahl der werte wollte ich nicht so gerne über formeln haben sonder am besten auch über vba!
wär schön wenn sich der sache mal jeman annehmen könnte da ich nicht so wirklich weiß wie das geht!
gruß marko

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Auswert() Dim arrQ, zz As Long, colH As New Collection, arrE() As Double arrQ = Application.Transpose(Workbooks("daten").Sheets("auftrag").Range("E5:E200")) For zz = 1 To UBound(arrQ) On Error Resume Next colH.Add arrQ(zz), CStr(arrQ(zz)) ' ohne Dubletten On Error GoTo 0 Next zz ReDim arrE(1 To 2, 1 To colH.Count) For zz = 1 To colH.Count arrE(1, zz) = colH(zz) arrE(2, zz) = WorksheetFunction.CountIf(Sheets("auftrag").Range("E5:E200"), _ arrE(1, zz)) Next zz With Workbooks("Übersicht").Worksheets(1) .Range(.Cells(5, 1), .Cells(colH.Count + 4, 2)) = Application.Transpose(arrE) End With End Sub

Hi Marko,
dann vielleicht so?


Option Explicit
Sub Auswert()
Dim arrQ, zz As Long, colH As New Collection, arrE(), rng As Range
With Workbooks("daten").Sheets("auftrag")
For Each rng In .Range("E5:E200")
If IsEmpty(rng) Then rng = "|LEER|"
Next rng
arrQ = Application.Transpose(.Range("E5:E200"))
For zz = 1 To UBound(arrQ)
On Error Resume Next
colH.Add arrQ(zz), CStr(arrQ(zz))   ' ohne Dubletten
On Error GoTo 0
Next zz
ReDim arrE(1 To 2, 1 To colH.Count)
For zz = 1 To colH.Count
arrE(1, zz) = colH(zz)
arrE(2, zz) = WorksheetFunction.CountIf(.Range("E5:E200"), arrE(1, zz))
Next zz
End With
With Workbooks("Übersicht").Worksheets(1)
.Range(.Cells(5, 1), .Cells(colH.Count + 4, 2)) = Application.Transpose(arrE)
End With
For Each rng In Workbooks("daten").Sheets("auftrag").Range("E5:E200")
If rng = "|LEER|" Then rng.ClearContents
Next rng
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Option Explicit Sub AuswertN() Dim arrQ, zz As Long, colH As New Collection, arrE(), rng As Range With Workbooks("daten").Sheets("auftrag") zz = IIf(IsEmpty(.Cells(200, 5)), .Cells(200, 5).End(xlUp).Row, 200) If zz

Beliebteste Forumthreads (12 Monate)

doppelte werte nur einmal auslesn

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

doppelte werte nur einmal auslesn

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread