Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
972to976
972to976
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blatt Filtern B Spalte und Zeileninhalt zusammenfü

Blatt Filtern B Spalte und Zeileninhalt zusammenfü
30.04.2008 17:20:00
helena
Hallo
Habe ein Problem zu lösen denke mit VBA sollte machbar sein, in File sind ca. 80 Zeilen gefüllt
mit zB. 10 gleiche Namen nun Zusammenzug erstellen von NAMEN und die Zellinhalte der
Einzelzeile Pro MA soll zusammengefügt werden (Zeile ist Zeitachse)
Habe File angehängt würde mich auf Hilfe freuen, ein bisschen VBA kann ich schon aber nicht
so Komplexe Sachen, kleine Sachen passe ich schon an.
DANKE gruss aus CH
helena
https://www.herber.de/bbs/user/51990.xls

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blatt Filtern B Spalte und Zeileninhalt zusamm
30.04.2008 17:31:21
Renee
Hi Helena,
Was ist die Regel für den Zusammenzug gemäss deiner Spalte P ? Kommt blau vor Grau ? oder was ?
Wieso VBA ? Wieviel Millionen Farben gibts in den Detail Feldern ?
GreetZ Renée

AW: Blatt Filtern B Spalte und Zeileninhalt zusamm
30.04.2008 17:36:00
helena
Danke für NAchfrage
als wenn doppelt belegt ist es grau, es gibt nur etwa 5 Farben und d.h. die Standardexcelfarben und nicht mehr. Mit diesen Farben rechne ich schon die Stunden zusammen es geht eher mehr um die JOB-Belegung zu sehen die Std. 4,8 usw. ist unwesentlich.
DANKE

AW: Blatt Filtern B Spalte und Zeileninhalt zusamm
30.04.2008 19:39:00
helena
habe folgenden Code gefunden und angepasst, habe aber noch das Problem er schreibt mir in anderes BLATT i.O aber er Listet ZELLINHALT FARBE immer noch pro NAMESEINTRAG d.h. wenn "AA" 10 Einträge hat schreibt er alles auch in 10 Zeilen statt in nur eine, ... nächste Name wieder nur in eine ... usw.
Global nam, t, s

Sub daten_uebertragen_all()
Application.ScreenUpdating = False
Dim nam(50, 400), tabe(1), dat(3, 400, 255)          ' Felder dimensionieren
Dim vonam(50, 100), pers(50, 100)                   ' Felder dimensionieren
tabe(1) = "1_Semester"                                   ' Namen der Tabellenblätter
t = 13                                              ' Startwert für Datenübertrag (Zeile 13)
' Inhalte einlesen
For u = 1 To 1                                      ' Aufruf Tabellenblatt
Worksheets(tabe(u)).Activate                        ' Tabellenblatt aktivieren
For s = 13 To 399                                ' Lesebereich (Zeile 13 bis Zeile 50) bei  _
bedarf vergrößern
If Len(Cells(s, 1)) > 0 Then                ' wenn Pers.Nr  dann...
'pers(u, s) = Cells(s, 1)                ' ... Personalnummer einlesen
nam(u, s) = Cells(s, 5)                 ' ... Name einlesen
'vonam(u, s) = Cells(s, 3)               ' ... Vorname einlesen
For sp = 4 To 255                       ' Start Schleife zum Einlesen der Farben
dat(u, s, sp) = Cells(s, sp).Interior.ColorIndex ' Farbnummern einlesen
Next sp
End If
Next s
Next u
Worksheets("alle Mo+IBS").Activate           ' Tabellenblatt aktivieren
Range("A13:C300").Select                             'Bereiche zum löschen aktivieren
Selection.ClearContents
Range("D13:IV300").Select
Application.Run "Trendsys08_V5.xls!Löschen"      ' starte Macro löschen
Range("A13").Select
b = 0
For u = 1 To 1                                      ' Tabelle 1-3 (tabe 1-3)
For s = 13 To 399                               ' von Zeile 13 bis 50
Do While Cells(s + b, 1)  ""              ' gefüllte Zellen finden
b = b + 1                               ' Schleifenzähler
Loop
'Cells(s + b, 1) = pers(u, s)                    ' Personalnummer in Tabelle schreiben
Cells(s + b, 2) = nam(u, s)                     ' Namen in Tabelle schreiben
'Cells(s + b, 3) = vonam(u, s)                   ' Vornamen in Tabelle schreiben
'For sp = 4 To 255
'If dat(u, s, sp)  4 Then GoTo sprung  ' wenn Farbe rot oder grün. _
'Cells(s + b, sp).Interior.ColorIndex = dat(u, s, sp)        ' ...Farben übertragen  _
sprung:
For sp = 4 To 255
If dat(u, s, sp) = 3 Or dat(u, s, sp) = 5 Or dat(u, s, sp) = 6 Or dat(u, s, sp) = 7 Or  _
dat(u, s, sp) = 16 Or dat(u, s, sp) = 34 Or dat(u, s, sp) = 41 Or dat(u, s, sp) = 48 Then
' wenn Farbe rot oder grün...
Cells(s + b, sp).Interior.ColorIndex = dat(u, s, sp)                    ' ...Farben ü _
bertragen
End If
Next sp
Next s
Next u
Application.ScreenUpdating = True
End Sub


DANKE
gruss helena

Anzeige
Verdichten !!! habe ich gefunden
30.04.2008 20:43:00
helena
aber ich möchte die doppelten NAMEN nur einmal in einer Tabelle in Zeile und die FARBIGEN Zeilen verdichtet auch farbig zu dem zugehörendem NAMEN
s. Musterfile
DANKE

Vielleicht eine Lösung...
30.04.2008 21:36:02
Renee
Hi Helena,
Ich hab mich an deine Vorgaben gehalten:
es geht eher mehr um die JOB-Belegung zu sehen die Std. 4,8 usw. ist unwesentlich.
Probier mal (Klick auf den SOLL-Knopf !) : https://www.herber.de/bbs/user/51993.xls
GreetZ Renée

na dem Ansatz nach perfekt ...
30.04.2008 22:32:00
helena
Hallo Renèe
vom Ansatz her mal perfekt und es erfüllt das SOLL soweit, wäre es Dier noch möglich bitte
die Kopie auf ein neues Blatt zu bringen, wo ich den Kopf schon vorbereitet habe 1;1 der Quelle
und wenn du so nett wärst mir die Varaiblen zu beschriften damit ich besser zu gang komme

Sub Verdichten()
Dim sLastMa As String
Dim lx As Long, lxx As Long, ly As Long
lx = 4    'Quelle Zeile 4 - Zeile 30
lxx = 30
Me.Range("B31:IV58").Clear  '--> auf Blatt "XY"
Do
If sLastMa  Me.Cells(lx, 2).Value Then
lxx = lxx + 1
Me.Range(Me.Cells(lx, 2), Me.Cells(lx, 256)).Copy Destination:=Me.Cells(lxx, 2)
Me.Range(Me.Cells(lxx, 4), Me.Cells(lxx, 256)).ClearContents
sLastMa = Me.Cells(lx, 2).Value
End If
ly = 4
Do
If (Me.Cells(lx, ly).Interior.ColorIndex > 0 Or _
Me.Cells(lx, ly).Interior.Pattern > 0) Then
Me.Cells(lxx, ly).Interior.ColorIndex = Me.Cells(lx, ly).Interior.ColorIndex
Me.Cells(lxx, ly).Interior.Pattern = Me.Cells(lx, ly).Interior.Pattern
End If
ly = ly + 1
Loop While ly  ""
End Sub


und vielen Dank und gruss aus der CH
werde heute nix mehr machen aber morgen nochmals checken undins File einbauen
Gute NAcht

Anzeige
AW: na dem Ansatz nach perfekt ...
30.04.2008 22:35:28
helena
noch eine kleine FRage wäre es möglich wenn in Zelle ein Text steht den auch mit zu kopieren ?
ABER ist kein muss, nice to have
gruss helena

habe noch exakteres Muster erstellt
01.05.2008 08:51:08
helena
Hallo Renèe
Bin ein schönes Stück weiter, denke es fehlt noch ein klein wenig
DANKE für Deine Hilfe, habe FILE angehängt im File ist noch beschrieben
was mir noch fehlt zum perfekt haben.
https://www.herber.de/bbs/user/51999.xls
DANKE für Deine Mühe
gruss helena

AW: habe noch exakteres Muster erstellt
01.05.2008 12:06:44
Renee
Hi Helena,
Eigentlich nicht so schwer, wenn man von Anfang an einen strukturierten Code und noch vorher eine genaue Anforderungs-Beschreibung hat ;-)
Code in ein Modul und die Referenzierung zu den Zellen ändern, that's all.
https://www.herber.de/bbs/user/52002.xls
Wenn du die Zahlen in den Zellen auch noch willst, fügst du nach dem .Pattern kopieren noch diese Zeile ein:

wsZ.Cells(lxx, ly).Value = wsQ.Cells(lx, ly + 5).Value


GreetZ Renée

Anzeige
DANKE Dir vielmals ...
03.05.2008 07:55:00
helena
für die promte Hilfe, konnte leider nicht vorher antworten Internet war down
gruss helena

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige