Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
408to412
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellinhalte feststellen und zählen

Zellinhalte feststellen und zählen
Helmut
Hallo Excelprofis!
Ich möchte bei den ersten 20 Blättern meiner Mappe alle unterschiedlichen Werte in den Zellen "T11:T46" feststellen und deren Anzahl in das Blatt "Einzelüberweisungen" ab zelle "A3" einfügen.
Beispiel:
Ausgabe im Blatt "Einzelüberweisungen"
SpalteA SpalteB
Wert Anzahl
15,00 20
16,00 13
.
.
.
.
wie kann ich so etwas machen?
Danke für die Hilfe!
Helmut

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

Betreff
Benutzer
Anzeige
AW: Zellinhalte feststellen und zählen
ANdreas
Hallo Helmut,
hier mal mein Denkanstoß :)

Sub Makro1()
Dim i%, c As Range, r As Range
For i = 1 To 20
For Each c In Worksheets(i).Range("T11:T46")
If IsNumeric(c.Value) Then
With Worksheets("Einzelüberweisungen")
Set r = .Range("A3:A723") _
.Find(What:=c.Value, LookIn:=xlFormulas, LookAt _
:=xlWhole)
If Not r Is Nothing Then
r.Offset(0, 1).Value = r.Offset(0, 1).Value + 1
Else
.Range("A65536").End(xlUp).Offset(1, 0).Value = c.Value
.Range("A65536").End(xlUp).Offset(0, 1).Value = 1
End If
End With
End If
Next c
Next i
End Sub

Hoffe das hilft weiter,
Andreas
Anzeige
AW: Zellinhalte feststellen und zählen
Helmut
Hallo Andreas!
Funzt soweit, nur hätte ich gern noch alle Zellen, die den Wert "0" haben, ausgeschlossen von der Zählung.
Habe leider keine Ahnung von VBA.
Danke für deine Hilfe!
mfg, Helmut
AW: Zellinhalte feststellen und zählen
ANdreas
Hallo Helmut,
ist nur eine kleine Änderung:

Sub Makro1()
Dim i%, c As Range, r As Range
For i = 1 To 20
For Each c In Worksheets(i).Range("T11:T46")
If IsNumeric(c.Value) And Not c.Value = 0 Then
With Worksheets("Einzelüberweisungen")
Set r = .Range("A3:A723") _
.Find(What:=c.Value, LookIn:=xlFormulas, LookAt _
:=xlWhole)
If Not r Is Nothing Then
r.Offset(0, 1).Value = r.Offset(0, 1).Value + 1
Else
.Range("A65536").End(xlUp).Offset(1, 0).Value = c.Value
.Range("A65536").End(xlUp).Offset(0, 1).Value = 1
End If
End With
End If
Next c
Next i
End Sub

Viel Spaß,
Andreas
Anzeige
AW: Zellinhalte feststellen und zählen
Helmut
Hallo Helmut!
Funzt leider doch nicht, bei Ausführung des Makros wird immer ein Wert in Zelle A2 geschrieben und die Restlichen des gleichen Wertes in A3 (Also A2=60, B2 1 & A3=60, B3=14). Außerdem werden bei erneutem Makroaufruf die Wertanzahl nochmal aufaddiert. Die alten Werte müssten bei erneutem Aufruf gelöscht werden.
Danke für die Hilfe!
mfg, Helmut
AW: Zellinhalte feststellen und zählen
ANdreas
Hallo Helmut,
ich habs das so verstanden, dass in A2 und B2 die Überschrift steht, diese Zellen alsop nicht leer sind. Habs jetzt nochmal so geändert, dass es jetzt auch dann richtig läuft:

Sub Makro1()
Dim i%, c As Range, r As Range
With Worksheets("Einzelüberweisungen")
.Range("A3:B10000").ClearContents
For i = 1 To 20
For Each c In Worksheets(i).Range("T11:T46")
If IsNumeric(c.Value) And Not c.Value = 0 Then
Set r = .Range("A3:A723") _
.Find(What:=c.Value, LookIn:=xlFormulas, LookAt _
:=xlWhole)
If Not r Is Nothing Then
r.Offset(0, 1).Value = r.Offset(0, 1).Value + 1
Else
Set r = .Range("A65536").End(xlUp)
If r.Row = 1 Then Set r = .Range("A2")
r.Offset(1, 0).Value = c.Value
r.Offset(1, 1).Value = 1
End If
End If
Next c
Next i
End With
End Sub

Viel Spaß,
Andreas
Anzeige
AW: Jetzt funzt es wirklich, Danke!!!
05.04.2004 16:49:11
Helmut
Jetzt funzt es, Danke!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige