MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 12.09.2017, 14:39   #1
LoganGr
Neuer Benutzer
Neuer Benutzer
Standard Excel2010 - copy/paste dynamischer Tabellen in 2 sheets

Hallo Ihr lieben Experten,
zur Zeit arbeite ich an einer Tabelle mit der ich über eine Dropdownliste, mir den Firmename und einer zweiten Dropdownliste den Ansprechpartner, in Abhängigkeit der Firma (in der ersten Dropdownliste), anzeigen lassen kann.
Zum Aufbau:
Es existieren 2 Worksheets einmal "Liste" und einmal "Firmen".
Im Worksheet "Liste" werden die Firmennamen in einer dynamischen Tabelle dargestellt und hier wird die Tabelle um weitere Firmen erweitert.
Im Worksheet "Firmen" wird die Struktur der Dropdownlisten erzeugt, heißt:
Hier existieren nochmal 2 dynamische Tabellen in denen die Firmennamen und Ansprechpartner aufgelistet werden.
(im Anhang ist eine Beispieldatei beigefügt)

Mein Ziel:
Wenn ich die dynamische Tabelle, in "Liste", erweitere und auf ein Makro-knopf drücke, möchte ich, dass der Firmenname von der untersten position der Tabelle, in die unterste Zeile der dynamischen Tabelle im Worksheet "Firma" geschrieben wird.


[Später soll der Name + Ansprechpartner in eine dritte dynamische Tabelle im Worksheet "Firma" eingefügt werden, allerdings an die letzte Spalte, da es eine von links nach rechts laufende Tabelle ist.]
das lässt sich aber denk ich mit der gleichen Art und Weise bewerkstelligen und kopieren wie in dem eben beschriebenen Problem.


Ich selber hab mit VBA leider nicht so viel Erfahrung, dass ich selber viel Code schreiben kann, ich habe mir allerdings schon einiges angelesen und für meine Zwecke das Ein oder Andere schon kopiert.
Z.B. weiß ich, dass:

Zeile1 = Worksheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row

mich an die letzte Zeile meiner dynamischen Tabelle im sheet "Liste" bringt.
Wie ich jetzt den Kopier und Einfügen Befehl einbringe, sodass er mir die Werte an die letzte Stelle schreibt, da bin ich leider überfragt.
Hier bitte ich euch ganz lieb um Hilfe!
vielen Dank schon mal im voraus!!

Lieben Gruß
LoganGr
Angehängte Dateien
Dateityp: xlsx Firma_Ansprechpartner.xlsx (12,5 KB, 3x aufgerufen)
LoganGr ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 15:01   #2
R J
MOF Meister
MOF Meister
Standard

Hi Logan,

weshalb denn so umständlich?
Alle benötigten Daten stehen in der Tab_Liste. Da es sich um eine formatierte Tabelle handelt, passt sich der Bereich bei Erweiterung auch automatisch an.
Außerdem kannst Du gleich hier alle Daten entweder nach Firmennamen und/oder Ansprechpartnern filtern. Weshalb Du jetzt noch ein extra Dropdown zum Filtern (und somit den gleichen Effekt) brauchst, ist mir nicht ganz klar.
Das mag zwar eine schöne Spielerei sein, jedoch ohne weiteren praktischen Nutzen.Das Gegenteil ist der Fall. Du rreichst Datenredundanz, verbrauchst mehr Zeit und Space und erhöhst die Fehleranfälligkeit.
Ich würde Dir empfehlen, das Vorhaben noch einmal zu überdenken.

Aber.... falls Du drauf bestehst....
Code:

Sub Kopieren()
    Tabelle1.ListObjects("Tab_Liste").DataBodyRange.Copy Destination:=Tabelle2.ListObjects("Tab_Firma").DataBodyRange
End Sub

__________________

Ciao, Ralf

Auf, zum Markplatz der Ideen!
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.
Diskussion


Geändert von R J (12.09.2017 um 15:18 Uhr).
R J ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 16:20   #3
LoganGr
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo R J,
vielen Dank für deine wahnsinnig schnelle Antwort!
Grundsätzlich geb ich dir da absolut recht mit dem was du sagst.
Es kommen hier leider ein paar sachen auf einmal zusammen:
  • Die Tabelle in "Liste" ist hier nur exemplarisch dargestellt, in Wirklichkeit ist die wesentlich umfangreicher mit wesentlich mehr Zeilen und Spalten, da es auch mehr als nur einen Ansprechpartner pro Firma existiert.
  • Damit Der Firmenname in der Dropdownliste nur einmal angezeigt wird, gibts die zweite Tabelle im Sheet "Firmen".
  • Die beiden Dropdownlisten sind leider so gewünscht worden
  • Ich habe auch ehrlich gesagt auf die schnelle keine Idee wie man es eleganter lösen könnte, dafür fehlt mir noch die Erfahrung

Zu deinem Code: Der funktioniert in der Beispieldatei wunderbar, aber in der Eigenltichen Excel-Datei leider nicht wie gewünscht.
Ich muss zu meiner Schande gestehen ich hab mich auch nicht richtig ausgedrückt, Entschuldige hierfür!
In Worksheet "Liste" soll nur die letzte Zelle von z.B. "Firmenname" kopiert werden.
In den Folgenden Spalten stehen dann weitere Informationen und dann an 4. Stellel der Ansprechpartner.
Also sinngemäß so: "gehe zu Worksheet "Liste", nimm letzte Zelle von "Firmenname/ oder was gewünscht" kopiere diesen Inhalt und gib ihn, in Worksheet "Firma", in der letzten freien Zelle der Tabelle "firmenname", wieder aus.

Die einzelnen Informationen hätte ich mit dem gleichen Code rausgefiltert.

Ich ändere mal die Beispieldatei ein wenig ab, sodass sie mehr wie das Original aussieht.

nochmal vielen lieben Dank für deine Antwort RJ!

Ganz liebe Grüße
LoganGr
Angehängte Dateien
Dateityp: xlsm Firma_Ansprechpartner_mit.xlsm (20,6 KB, 2x aufgerufen)
LoganGr ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2017, 21:47   #4
R J
MOF Meister
MOF Meister
Standard

...wenn ich das richtig sehe, kommt es Dir gar nicht auf die beiden Tabellen an, sondern wichtig sind Dir die beiden Dropdowns in D14 und D15?

__________________

Ciao, Ralf

Auf, zum Markplatz der Ideen!
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.
Diskussion

R J ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2017, 08:35   #5
LoganGr
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo RJ,
ja, da hast du recht!
Wie gesagt, die Dropdownlisten sind leider (von oben) so gewünscht

Aber um auf das eigentliche Problem zurück zu kommen:
Kann mir wer vielleicht sagen wie ich sowohl die Copy als auch die paste Anweisung mit "nimm letze Zeile" und "springe in letzte freie Zeile" kombinieren kann?
Das würde mir unfassbar helfen

Vielen Dank
und auch dir nochmals vielen Dank RJ für deinen Verbesserungsvorschlag auch, wenn ich nicht um die Dropdowns rum komme!

ganz liebe grüße
LoganGr
LoganGr ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2017, 11:11   #6
R J
MOF Meister
MOF Meister
Standard

Hi Logan,

copy und Paste kannst Du Dir mi untenstehender Lösung sparen.

1. Habe Deinen (im Beispiel entfernten, aber im Beispielcode vorhandenen) CommandButton1 mal umbenannt in cmdAktualisieren. Entweder Du machst das bei Dir auch oder musst dann die Prozedur für das Click Ereignis des Buttons anpassen.

2. Entferne die beiden dyn. Tabellen im Blatt Firma. Die werden nicht mehr gebraucht.

3. Füge untenstehenden Code in das Modul von Blatt Firma

Code:

Option Explicit
'(C) 09/2017 * Ralf Anton * ralf-anton@t-online.de

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target <> "" And Target.Column = 4 And Target.Row = 14 Then FillDropDowns
    Err.Clear
End Sub

Private Sub cmdAktualisieren_Click()
    FillDropDowns 1
End Sub

Sub FillDropDowns(Optional Spalte As Byte = 0)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lo As ListObject
Dim Wert As String, lastRow As Long
Dim rng As Range, ziel As Range, var

With ThisWorkbook

    Set ws1 = .Worksheets("Liste")
    Set ws2 = .Worksheets("Firma")
    Set lo = ws1.ListObjects("Tab_Liste")
                                  '       D14 = Firma, D15 = Namen
    Set ziel = IIf(Spalte = 1, ws2.Range("D14"), ws2.Range("D15"))
    
        With ws1.Range("Tab_Liste[[#All],[Firmenname]]")
            lastRow = lo.DataBodyRange.Rows.Count + lo.Range.Row
           If Spalte = 1 Then .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
            
            Set rng = ws1.Range("A2:A" & lastRow).Cells.SpecialCells(xlCellTypeVisible)
            
                For Each var In rng
                    If Spalte = 1 Then
                        Wert = Wert & var & ","
                    Else
                        If var = ws2.Range("D14") Then Wert = Wert & var.Offset(0, 4) & ","
                    End If
                Next
                
            ziel = ""
                With ziel.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Mid(Wert, 1, Len(Wert) - 1)
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            
            .AutoFilter
            ziel.Select
        End With
    Set ziel = Nothing
    Set rng = Nothing
    Set lo = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing

End With
End Sub

__________________

Ciao, Ralf

Auf, zum Markplatz der Ideen!
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.
Diskussion

R J ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.09.2017, 09:19   #7
LoganGr
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Ralf,
dein Programm ist einfach genial!
Großartig! Ich hab noch nicht ganz verstanden wie es funktioniert, aber ich hab es an mein Ursprungsdokument angepasst und es ist ein Traum!
Es funktioniert einwandfrei und spart Platz!
Vielen vielen vielen Dank, sowohl für deine Geduld als auch deine Mühe!

Ganz lieben Gruß

Logan
LoganGr ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.09.2017, 14:45   #8
LoganGr
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard erweiterbar?

Hallo nochmal,
Jetzt dachte ich schon ich bräuchte keine Hilfe und ich hätte es selber gelöst, aber wie so oft kam dann das nächste Problem.
Der ursprüngliche Code funktioniert weiterhin einwandfrei!
Jetzt wollte ich fragen wo ich denn da was verändern könnte damit ich den code mehrmals in ähnlichen Situationen einsetzen kann.
Ich hab mal ein wenig rum probiert und kam einmalig auf mein gewünschtes ergebnis. Danach kam dann der Fehler 1004 "Anwendungs oder Objektdefinierter Fehler"
Hier mal der Versuch das Programm wo anders ein zu setzen:
(Der Fehler wurde hier mit dem debugger Orange markiert)

Code:

Option Explicit
'(C) 09/2017 * Ralf Anton * ralf-anton@t-online.de


Private Sub Worksheet_Change2(ByVal Target As Range)
On Error Resume Next
    If Target <> "" And Target.Column = 9 And Target.Row = 15 Then FillDropDowns2
    Err.Clear
End Sub


Sub FillDropDowns2(Optional Spalte2 As Byte = 0)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lo As ListObject
Dim Wert As String, lastRow As Long
Dim rng As Range, ziel As Range, var

With ThisWorkbook

    Set ws1 = .Worksheets("Firmen")
    Set ws2 = .Worksheets("Bestellung")
    Set lo = ws1.ListObjects("Tab_Kartoffel")
                                  '       I15 = Name,
    Set ziel = IIf(Spalte2 = 1, ws2.Range("I15"), ws2.Range("I15")) ' Ich wusste keinen sinnvollen Falsepart 
    
        With ws1.Range("Tab_Kartoffel[[#All],[Name]]")
            lastRow = lo.DataBodyRange.Rows.Count + lo.Range.Row
           If Spalte = 1 Then .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
            '                              B13 ist gewünscht 
            Set rng = ws1.Range("B13:B" & lastRow).Cells.SpecialCells(xlCellTypeVisible)
            
                For Each var In rng
                    If Spalte = 1 Then
                        Wert = Wert & var & ","
                    Else
                        If var = ws2.Range("I15") Then Wert = Wert & var.Offset(0, 0) & ","
                    End If
                Next
                
            ziel = ""
                With ziel.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Mid(Wert, 1, Len(Wert) - 1)
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            
            .AutoFilter
            ziel.Select
        End With
    Set ziel = Nothing
    Set rng = Nothing
    Set lo = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing

End With
End Sub
Wo liegt denn hier der Fehler und wie kann ich den Ursprungscode verändern, dass ich ihn mehrmals einsetzen kann
Vielen Dank schon mal im vorraus

Ganz lieben Gruß
Logan

Geändert von LoganGr (14.09.2017 um 15:11 Uhr). Grund: Nach einmaliger korrekten Funktion kam ein neuer Fehler
LoganGr ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.09.2017, 20:06   #9
R J
MOF Meister
MOF Meister
Standard

...dazu müsste ich wissen, was Du genau vorhast.

Das hier:
Code:

If var = ws2.Range("I15") Then Wert = Wert & var.Offset(0, 0) & ","
ist schon mal überflüssig....

und wird hier:
Code:

     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Mid(Wert, 1, Len(Wert) - 1)
möglicherweise zum Fehler führen...

__________________

Ciao, Ralf

Auf, zum Markplatz der Ideen!
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.
Diskussion

R J ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:18 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.