Automatisches Tabellen auffüllen

Bild

Betrifft: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 09.10.2015 11:54:47

Hallo zusammen,
da ich mit meinem Excelwissen am Ende bin brauch ich Eure Hilfe.
In Tabelle 2 habe ich von Zeile 8 bis 460 meine Eingaben
In Tabelle 1 sollen ab B5 die laufenden Farben stehen
Ab C5 möchte ich die laufenden Ergebnisse aus Tabelle 2 stehen haben, sollte B5 für die Farbe belegt sein so sollte in der Spalte d5 das nächste Ergebnis stehe usw. bis L5, bis Zeile 24
Sollte ich in Tab 2 einen Neun Namen eingeben, so sollte dieser in Tab 1 aufgefüllt werden
Als Beispiel habe ich eine Mappe hochgeladen
https://www.herber.de/bbs/user/100680.xlsx
Herzlichen Dank vor ab an alle die mir helfen können
Gruß wuppi

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: ChrisL
Geschrieben am: 09.10.2015 13:19:21
Hi
Alt + F11, links Doppelklick auf Tabelle 1, Code einfügen:

Private Sub Worksheet_Activate()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim rZelle As Range, lZeile As Long
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
Application.ScreenUpdating = False
WS1.Rows("5:10000").EntireRow.Delete
For Each rZelle In WS2.UsedRange
    If Not IsNumeric(rZelle) Then
        If WorksheetFunction.CountIf(WS1.Columns(2), rZelle) = 0 Then
            lZeile = WS1.Range("B65536").End(xlUp).Row + 1
            If lZeile < 5 Then lZeile = 5
            WS1.Cells(lZeile, 1) = "'" & lZeile - 4 & "."
            WS1.Cells(lZeile, 2) = rZelle
            WS1.Cells(lZeile, 3) = rZelle.Offset(0, 1)
        Else
            lZeile = Application.Match(rZelle, WS1.Columns(2), 0)
            WS1.Range("IV" & lZeile).End(xlToLeft).Offset(0, 1) = rZelle.Offset(0, 1)
        End If
    End If
Next rZelle
With WS1.Sort
    .SetRange WS1.Range("B5:L" & WS1.Range("B65536").End(xlUp).Row)
    .Header = xlNo
    .Apply
End With
Application.ScreenUpdating = True
End Sub

cu
Chris

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 09.10.2015 13:27:10
Danke Chris
Gruß wuppi

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 10.10.2015 13:25:13
Hallo Chris,
habe da zwei Probleme:
in Spalte L sollte das auffüllen beendet sein und bei der Spalte A sollte die Eigaben mir 1. und 2. anfangen. Herzlichen Dank
CU wuppi

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 10.10.2015 14:03:39
Hallo Chris,
habe da zwei Probleme:
in Spalte L sollte das auffüllen beendet sein und bei der Spalte A sollte die Eigaben mir 1. und 2. anfangen. Herzlichen Dank
CU wuppi

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: ChrisL
Geschrieben am: 12.10.2015 08:45:34
Hi
Problem 1 kann ich nachvollziehen:

Private Sub Worksheet_Activate()
   Dim WS1 As Worksheet, WS2 As Worksheet
   Dim rZelle As Range, lZeile As Long, lSpalte As Long
   
   Set WS1 = Worksheets("Tabelle1")
   Set WS2 = Worksheets("Tabelle2")
   
   Application.ScreenUpdating = False
   WS1.Rows("5:10000").EntireRow.Delete
   
   For Each rZelle In WS2.UsedRange
       If Not IsNumeric(rZelle) Then
           If WorksheetFunction.CountIf(WS1.Columns(2), rZelle) = 0 Then
               lZeile = WS1.Range("B65536").End(xlUp).Row + 1
               If lZeile < 5 Then lZeile = 5
               WS1.Cells(lZeile, 1) = "'" & lZeile - 4 & "."
               WS1.Cells(lZeile, 2) = rZelle
               WS1.Cells(lZeile, 3) = rZelle.Offset(0, 1)
           Else
               lZeile = Application.Match(rZelle, WS1.Columns(2), 0)
               lSpalte = WS1.Range("IV" & lZeile).End(xlToLeft).Column + 1
               If lSpalte < 13 Then WS1.Cells(lZeile, lSpalte) = rZelle.Offset(0, 1)
           End If
       End If
   Next rZelle
   
   With WS1.Sort
       .SetRange WS1.Range("B5:L" & WS1.Range("B65536").End(xlUp).Row)
       .Header = xlNo
       .Apply
   End With
   Application.ScreenUpdating = True
   End Sub

Problem 2 verstehe ich nicht.
cu
Chris

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 12.10.2015 09:43:47
Hallo Chris,
das Problem 2 ist ein Denkfehler von mir.
Für PROBLEM1 habe ich die Datei hochgeladen.
https://www.herber.de/bbs/user/100717.xlsx
wenn ich den Sheet starte löscht er mir die Spalte N
Vielen Dank
CU wuppi

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: ChrisL
Geschrieben am: 12.10.2015 11:15:55
Hi
So...

Private Sub Worksheet_Activate()
   Dim WS1 As Worksheet, WS2 As Worksheet
   Dim rZelle As Range, lZeile As Long
   
   Set WS1 = Worksheets("Tabelle1")
   Set WS2 = Worksheets("Tabelle2")
   
   Application.ScreenUpdating = False
   WS1.Range("A16:N" & WS1.Range("A65536").End(xlUp).Row).ClearContents
   
   For Each rZelle In WS2.UsedRange
       If Not IsNumeric(rZelle) Then
           If WorksheetFunction.CountIf(WS1.Columns(2), rZelle) = 0 Then
               lZeile = WS1.Range("B65536").End(xlUp).Row + 1
               If lZeile < 16 Then lZeile = 16
               WS1.Cells(lZeile, 1) = "'" & lZeile - 15 & "."
               WS1.Cells(lZeile, 2) = rZelle
               WS1.Cells(lZeile, 3) = rZelle.Offset(0, 1)
           Else
               lZeile = Application.Match(rZelle, WS1.Columns(2), 0)
               If WS1.Cells(lZeile, 14) = "" Then _
               WS1.Range("O" & lZeile).End(xlToLeft).Offset(0, 1) = rZelle.Offset(0, 1)
           End If
       End If
   Next rZelle
   
   With WS1.Sort
       .SetRange WS1.Range("B16:N" & WS1.Range("B65536").End(xlUp).Row)
       .Header = xlNo
       .Apply
   End With
   Application.ScreenUpdating = True
   End Sub

cu
Chris

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 12.10.2015 12:54:25
jo ;)
herzlichen Dank
CU Wuppi

Bild

Betrifft: Zeilen löschen
von: MCO
Geschrieben am: 13.10.2015 06:52:41
Moin!
die Zeilen werden nur gelöscht, wenn der Minimalwert in "A" nicht richtig gesetzt wird, wenn also in "A" nix steht.
Ersetze

WS1.Range("A16:N" & WS1.Range("A65536").End(xlUp).Row).ClearContents

durch
      lz = WS1.Range("A65536").End(xlUp).Row
   WS1.Range("A16:N" & WorksheetFunction.Max(lz, 16)).ClearContents
dann passiert unter Zeile 16 gar nichts.
Wie gesagt, der Fehler ist aber eigentlich ein anderer.
Gruß, MCO

Bild

Betrifft: AW: Zeilen löschen
von: ChrisL
Geschrieben am: 13.10.2015 08:24:56
Hi
In Spalte A steht immer etwas:
WS1.Cells(lZeile, 1) = "'" & lZeile - 15 & "."
Max funktioniert in diesem Fall nicht, da es sich um einen Text handelt.
Was nun aber der Fehler ist, verstehe ich nicht. Mit der Beispieldatei hat der Code m.E. funktioniert.
cu
Chris

Bild

Betrifft: AW: Zeilen löschen
von: MCO
Geschrieben am: 13.10.2015 10:05:25
Hi!
Mit


WS1.Range("A65536").End(xlUp).Row
bekommst du eine Zeilennummer ausgegeben.
Die 16 setze ich von Hand. Also kann ich auch die letzte Zeile per max-funktion ermitteln, nämlich so, das entweder 16 oder ein Wert größer 16 rauskommt, auch wenn in "A" nix steht. Mit dem eigentlichen Zellinhalt hat das nix zu tun.
Der Code funtioniert auch, wenn von Anfang an in "A" etwas drinsteht.
Wenn

WS1.Range("A16:N" & WS1.Range("A65536").End(xlUp).Row
als Ergebnisbereich "A16:N1" liefert, weil WS1.Range("A65536").End(xlUp).Row = 1 ergibt, wird der falsche Bereich gelöscht.
Du kannst es leicht nachvollziehen, wenn du von hand in der Tabelle Zelle A65536 anwählst und dann STRG+(Cursor nach oben) drückst.
In diesem Fall muß man mal wieder mit den ungeplanten Machenschaften des users rechnen.
Gruß, MCO

Bild

Betrifft: AW: Zeilen löschen
von: ChrisL
Geschrieben am: 13.10.2015 13:03:13
Hi
Stimmt, deinen Punkt mit Max sehe ich nun.
cu
Chris

Bild

Betrifft: AW: Automatisches Tabellen auffüllen
von: wuppi
Geschrieben am: 12.10.2015 22:08:52
hallo chris,
wenn jetzt noch die obersten zeilen 1-14 nicht gelöscht werden
wäre das super
ch wuppi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Automatisches Tabellen auffüllen"