Microsoft Excel

Herbers Excel/VBA-Archiv

Blatt Filtern B Spalte und Zeileninhalt zusammenfü

Betrifft: Blatt Filtern B Spalte und Zeileninhalt zusammenfü von: helena
Geschrieben am: 30.04.2008 17:20:54

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

  

Betrifft: AW: Blatt Filtern B Spalte und Zeileninhalt zusamm von: Renee
Geschrieben am: 30.04.2008 17:31:21

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


  

Betrifft: AW: Blatt Filtern B Spalte und Zeileninhalt zusamm von: helena
Geschrieben am: 30.04.2008 17:36:38

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


  

Betrifft: AW: Blatt Filtern B Spalte und Zeileninhalt zusamm von: helena
Geschrieben am: 30.04.2008 19:39:55

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) < 3 Or 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


  

Betrifft: Verdichten !!! habe ich gefunden von: helena
Geschrieben am: 30.04.2008 20:43:32

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


  

Betrifft: Vielleicht eine Lösung... von: Renee
Geschrieben am: 30.04.2008 21:36:02

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


  

Betrifft: na dem Ansatz nach perfekt ... von: helena
Geschrieben am: 30.04.2008 22:32:16

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 < Me.Cells(lx, Me.Columns.Count).End(xlToLeft).Column + 1
        lx = lx + 1
    Loop While Me.Cells(lx, 2) <> ""
End Sub



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


  

Betrifft: AW: na dem Ansatz nach perfekt ... von: helena
Geschrieben am: 30.04.2008 22:35:28

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


  

Betrifft: habe noch exakteres Muster erstellt von: helena
Geschrieben am: 01.05.2008 08:51:08

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


  

Betrifft: AW: habe noch exakteres Muster erstellt von: Renee
Geschrieben am: 01.05.2008 12:06:44

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


  

Betrifft: DANKE Dir vielmals ... von: helena
Geschrieben am: 03.05.2008 07:55:56

für die promte Hilfe, konnte leider nicht vorher antworten Internet war down

gruss helena


 

Beiträge aus den Excel-Beispielen zum Thema "Blatt Filtern B Spalte und Zeileninhalt zusammenfü"