PDA

Vollständige Version anzeigen : Werte nach Spalte auflisten


holzwurm76
02.07.2015, 12:36
Hallo,

ich habe eine Tabellenblatt, indem in Spalte A diverse Artikel aufgelistet sind.
Diese kommen auch doppelt und dreifach vor. In Spalte B ist der dazugehörige Mitarbeiter und in Splate C die Zeit.

Nun möchte ich ein Makro erstellen, welches zunächst Spalte A durchläuft und alle Artikel in einem neuen Tabellenblatt auflistet, allerdings nur einmal. Er fängt also bei A1 an, schreibt den Wert in A1 beim neuen Tabellblatt, schaut dann wieder in A2 ob der Wert anders ist als A1, wenn ja, dann schreibt er den neuen Wert in A2(neues Tabellenblatt), wenn nein dann schaut er in A3 nach, und so weiter.

Dann soll er in die Zeilen (A1 bis A xxxx) das selbe mit den Mitarbeiternamen machen, so dass eine Matrix entsteht???

Kann mir hier jemand helfen, ich komme nicht so recht weiter....

Hasso
02.07.2015, 13:50
Hallo Holzwurm,

bei mir klappt das so:Option Explicit

Sub Artikelliste()

Dim rngzelle As Range
Dim lngLetzteZeile As Long
Dim lngZielZeile As Long
Dim intSpalte As Integer

'Alte Einträge auf Blatt 2 löschen:
Worksheets("Tabelle2").Range("A:B").ClearContents

'Artikelliste mit eindeutigen Werten kopieren:
lngZielZeile = 1
lngLetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
For Each rngzelle In Worksheets("Tabelle1").Range("A1:A" & lngLetzteZeile)
'Gibt es den Artikel auf Blatt 2 noch nicht, dann:
If Application.WorksheetFunction.CountIf(Worksheets("Tabelle2").Range("A1:A" & lngZielZeile), rngzelle) = 0 Then
rngzelle.Copy Worksheets("Tabelle2").Cells(lngZielZeile, 1)
lngZielZeile = lngZielZeile + 1
End If
Next rngzelle

'Namensliste mit eindeutigen Werten kopieren:
lngZielZeile = 1
lngLetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row
For Each rngzelle In Worksheets("Tabelle1").Range("B1:B" & lngLetzteZeile)
'Gibt es den Namen auf Blatt 2 noch nicht, dann:
If Application.WorksheetFunction.CountIf(Worksheets("Tabelle2").Range("B1:B" & lngZielZeile), rngzelle) = 0 Then
rngzelle.Copy Worksheets("Tabelle2").Cells(lngZielZeile, 2)
lngZielZeile = lngZielZeile + 1
End If
Next rngzelle
End Sub

Die beiden Schleifen könnte man noch in eine packen, aber das war mir jetzt zu aufwendig.

holzwurm76
03.07.2015, 09:16
Hallo Hasso,

vielen Dank, das klappt super.

Ein Problem habe ich zunächst noch. Ich möchte die Mitarbeiter, die in der ersten Tabelle in Spalte C sind, nicht in die Spalte B einfügen, sondern als Matrix in die Zeile. Also den ersten Mitarbeiter in B1, den zweiten in C1 usw...

Ich komm einfach nicht darauf wie ich das umbauen soll....

Vielleicht kannst Du mir nochmal helfen,

besten Dank!!!!

Hasso
03.07.2015, 09:50
Hallo Holzwurm,

ändere den Code so:Option Explicit

Sub Artikelliste()

Dim rngzelle As Range
Dim lngLetzteZeile As Long
Dim lngZielZeile As Long
Dim intSpalte As Integer
Dim intZielSpalte As Integer

'Alte Einträge auf Blatt 2 löschen:
Worksheets("Tabelle2").Range("A:B").ClearContents

'Artikelliste mit eindeutigen Werten kopieren:
lngZielZeile = 2
lngLetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
For Each rngzelle In Worksheets("Tabelle1").Range("A1:A" & lngLetzteZeile)
'Gibt es den Artikel auf Blatt 2 noch nicht, dann:
If Application.WorksheetFunction.CountIf(Worksheets("Tabelle2").Range("A1:A" & lngZielZeile), rngzelle) = 0 Then
rngzelle.Copy Worksheets("Tabelle2").Cells(lngZielZeile, 1)
lngZielZeile = lngZielZeile + 1
End If
Next rngzelle

'Namensliste mit eindeutigen Werten kopieren:
intZielSpalte = 2
lngLetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row
For Each rngzelle In Worksheets("Tabelle1").Range("B1:B" & lngLetzteZeile)
'Gibt es den Namen auf Blatt 2 noch nicht, dann:
With Worksheets("Tabelle2")
If Application.WorksheetFunction.CountIf(.Range(.Cells(1, 2), .Cells(1, intZielSpalte)), rngzelle) = 0 Then
rngzelle.Copy Worksheets("Tabelle2").Cells(1, intZielSpalte)
intZielSpalte = intZielSpalte + 1
End If
End With
Next rngzelle
End Sub

holzwurm76
03.07.2015, 10:14
Super,

jetzt funzt es...

Genau das habe ich gebraucht...

Vielen herzlichen Dank...

holzwurm76
03.07.2015, 10:31
Hallo Hasso,

ich habe meine Datei mal angehängt:

Ich möchte jetzt in die entstandene Matrix einen berechneten Mittelwert eines Mitarbeiters aus dem Tabellenblatt "Hellermann" aus Spalte I einfügen.

Ich stelle mir das so vor:

Gehe in das Tabellenblatt "Hellermann" setze den Autofilder für Artikelnummer "XY" und für den Mitarbeiter "AB", berechne den Mittelwert aus Spalte I und füge diesen in die Matrix in Tabellenblatt "Artikelauswertung" unter dem Mitarbeiter "AB" und dem Artikel "XY"

Nun könnte für jede Zelle diesen Code eingeben, oder geht das auch irgendwie einfacher???

Hasso
03.07.2015, 13:39
Hallo Holzwurm,

meine Gehirnwindungen sind lansam heißgelaufen, aber ich glaube, ich habe eine Lösung gefunden. Diese erzeugt zwar eine Monsterformel, aber ich denke, das Ergebnis stimmt.Sub Makro1()


Dim rngZelle As Range
Dim lngLetzteZeile As Long
Dim lngZielZeile As Long
Dim intSpalte As Integer
Dim intZielSpalte As Integer


'Alte Einträge auf Blatt 2 löschen:
Worksheets("Auswertungstabelle").Range("A:z").ClearContents

'Artikelliste mit eindeutigen Werten kopieren:
lngZielZeile = 2
lngLetzteZeile = Worksheets("Hellermann").Cells(Rows.Count, 1).End(xlUp).Row
For Each rngZelle In Worksheets("Hellermann").Range("A2:A" & lngLetzteZeile)
'Gibt es den Artikel auf Blatt 2 noch nicht, dann:
If Application.WorksheetFunction.CountIf(Worksheets("Auswertungstabelle").Range("A1:A" & lngZielZeile), rngZelle) = 0 Then
rngZelle.Copy Worksheets("Auswertungstabelle").Cells(lngZielZeile, 1)
lngZielZeile = lngZielZeile + 1
End If
Next rngZelle

'Namensliste mit eindeutigen Werten kopieren:
intZielSpalte = 2
lngLetzteZeile = Worksheets("Hellermann").Cells(Rows.Count, 3).End(xlUp).Row
For Each rngZelle In Worksheets("Hellermann").Range("c2:c" & lngLetzteZeile)
'Gibt es den Namen auf Blatt 2 noch nicht, dann:
With Worksheets("Auswertungstabelle")
If Application.WorksheetFunction.CountIf(.Range(.Cells(1, 2), .Cells(1, intZielSpalte)), rngZelle) = 0 Then
rngZelle.Copy Worksheets("Auswertungstabelle").Cells(1, intZielSpalte)
intZielSpalte = intZielSpalte + 1
End If
End With
Next rngZelle
Mittelwerte_eintragen
End Sub
Sub Mittelwerte_eintragen()

Dim lngAnzahlArtikel As Long
Dim lngZeit As Long
Dim lngZeile As Long
Dim lngLetzteZeile As Long
Dim rngZelle As Range
Dim intSpalte As Integer
Dim intLetzteSpalte As Integer
Dim lngZH

lngZH = Worksheets("Hellermann").Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Auswertungstabelle")
lngLetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
intLetzteSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column
For lngZeile = 2 To lngLetzteZeile
For intSpalte = 2 To intLetzteSpalte
' Die Formel bildet die Summe der gefertigten Artikel pro Artikel und Mitarbeiter und teilt diese durch die
' Summe der Zeiten pro Artikel und Mitarbeiter:
.Cells(lngZeile, intSpalte).FormulaLocal = _
"=WENNFEHLER(SUMMEWENNS(Hellermann!$F$2:$F$" & lngZH & ";Hellermann!$A$2:$A$" & lngZH & ";" & Cells(lngZeile, 1) & ";Hellermann!$C$2:$C$" & lngZH & ";" & Chr(34) & Cells(1, intSpalte) & Chr(34) & _
")/SUMMEWENNS(Hellermann!$H$2:$H$" & lngZH & ";Hellermann!$A$2:$A$" & lngZH & ";" & Cells(lngZeile, 1) & ";Hellermann!$C$2:$C$" & lngZH & ";" & Chr(34) & .Cells(1, intSpalte) & Chr(34) & ");" & Chr(34) & Chr(34) & ")"
Next intSpalte
Next lngZeile
End With
End Sub

holzwurm76
03.07.2015, 13:59
Hallo Hasso,

wie geil ist das denn!!!!

So viel hätte ich ja im Leben nicht erwartet, Du hast ja alles fertig gemacht....


Vielen Vielen Dank, das hätte ich nie hinbekommen!!!

Ich wünsche Dir ein schönes, sonniges Wochenende...

holzwurm76
10.07.2015, 10:48
Hallo Hasse,
ich komme mal wieder nicht weiter!

Ich wollte jetzt noch in der Eingabetabelle (Hellermann) die berechnungsformeln für die Zeit und Stck/Zeit auf Knopfdruck nur in die belegten Zeilen eintragen. Also sozusagen nicht wie jetzt vorkonfiguriert!

Weiterhin wollte ich auf dem neuen Tabellenblatt "Auswertungsdetails" zwei Auswahlfelder, aus denen ich einen Artikel oder auch einen Mitarbeiter auswählen kann. Damit soll dann für den jeweiligen Artikel die 3 besten und die 3 schlechtesten Mitarbeiter angezeigt werden. Ebenso soll dies für den Mitarbeiter gemacht werden können, nämlich, daß hier seine 3 besten und 3 schlechtesten Artikel angezeigt werden.

Könntest Du mir hier mit einigen Tipps helfen????

Vielen Dank schonmal und schöne Grüße!!!!

Hasso
10.07.2015, 13:43
Hallo holzwurm76,Ich wollte jetzt noch in der Eingabetabelle (Hellermann) die berechnungsformeln für die Zeit und Stck/Zeit auf Knopfdruck nur in die belegten Zeilen eintragen. Also sozusagen nicht wie jetzt vorkonfiguriert!Das geht mit folgendem Code (aber warum sollen dann dort überhaupt Formeln eingetragen werden und nicht direkt die Werte?):Sub Formeln_in_Hellermann()

Dim lngZaehler As Long
Dim lngLetzteZeile As Long

With Worksheets("Hellermann")
lngLetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For lngZaehler = 2 To lngLetzteZeile
.Cells(lngZaehler, "H") = "=(($D" & lngZaehler & ">$E$" & lngZaehler & ")+$E$" & lngZaehler & "-$D$" & lngZaehler & ")*24"
.Cells(lngZaehler, "I") = "=$F" & lngZaehler & "/$H" & lngZaehler
Next lngZaehler
End With
End Sub

Weiterhin wollte ich auf dem neuen Tabellenblatt "Auswertungsdetails" zwei Auswahlfelder, aus denen ich einen Artikel oder auch einen Mitarbeiter auswählen kann. Damit soll dann für den jeweiligen Artikel die 3 besten und die 3 schlechtesten Mitarbeiter angezeigt werden. Ebenso soll dies für den Mitarbeiter gemacht werden können, nämlich, daß hier seine 3 besten und 3 schlechtesten Artikel angezeigt werden.
Das ist schon etwas schwieriger, zumal es bei den meisten Artikeln weniger als 6 Werte gibt, so dass die Anzeige der 3 besten und der 3 schlechtesten Mitarbeiter relativ sinnlos ist.
Ich habe da schon ein bisschen rumprogrammiert, aber das ist per VBA nicht so simpel (jedenfalls für mich). Außerdem widerstrebt mir als ehemaligem Betriebsrat eine solche Auswertung natürlich auch generell :(
Falls ich etwas finden sollte, melde ich mich.

holzwurm76
10.07.2015, 14:25
Hallo Hasso,

vielen Dank, natürlich müssen da nicht die Formeln rein, hätten auch gleich die Werte eingetragen werden können!!!
So ist es aber OK!!!
Vielen Dank.

Im Laufe der Zeit wird sich das Makro ja komplett füllen, dann gibt es nicht nur 6 Einträge sondern westentlich mehr. Diese Auswertung soll dafür genutzt werden, die Mitarbeiter an den richtigen Artikeln einzusetzen und nicht um Sanktionen zu bestimmen ;-), aber ich verstehe schon was Du meinst...

Wäre es denn einfacher nur die jeweils besten und schlechtesten Artikel/Mitarbeiter auszufiltern????

Vielen Dank schonmal!!!

xlph
10.07.2015, 15:02
Hallo holzwurm76,

dazu benötigst du kein VBA.

Nimm dafür Pivottabellen.

holzwurm76
10.07.2015, 17:26
Das wäre ja das was ich eigentlich suche, allerdings aktualisieren die sich nicht mit den neuen Daten, oder????

Kann ich soetwas nicht mittels VBA oder Makro Recorder nach jedem Durchlauf aufbauen lassen?

xlph
10.07.2015, 17:33
Das wäre ja das was ich eigentlich suche, allerdings aktualisieren die sich nicht mit den neuen Daten, oder????

- In Pivottabelle klicken
- Pivottable-Tools->Optionen->Daten->Aktualisieren->Alle Aktualisieren...

holzwurm76
10.07.2015, 18:15
super, genau so mach ich es...

Hab vielen Dank für Deine Hilfe...