Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Werte abhängig von Spaltenbezeichnung kopieren

Werte abhängig von Spaltenbezeichnung kopieren
Spaltenbezeichnung
Hallo liebes Excelforum,
bin mir jetzt nicht sicher, ob ich gegen eine Regel verstoße (habe zumindest diesbezüglich nichts einschränkendes gefunden), aber da ich auf meine Frage von gestern 11:21 Uhr leider keine Rückmeldung erhalten habe, poste ich meine Frage, diesmal etwas anders formuliert, nocheinmal.
Ich möchte von einem Tabellenblatt zu einem anderen derselben Datei bestimmte Werte übertragen.
"Zuordnungstabelle" beinhaltet einen Ausschnitt der "Adresseneingabe", auf "Zuordnungstabelle" wird von einer anderen Datei per SVERWEIS zugriffen, so dass die Spaltenanordnung so bleiben muss.
In "Adresseingabe" könnte es sein, dass neue Felder eingefügt werden müssen.
Es werden nur Werte mit einem Eintrag "a" in Spalte A übertragen.
Problem: Die Werteübertragung erfolgt mittels nachstehendem Code, der einen Bereich auswählt, kopiert und wieder einfügt. Wenn die Spalten in "Adresseingabe" sich ändern, werden die Werte u.U. den falschen Spalten in "Zuordnungstabelle" zugeordnet.
Sub Tabelle_füllen()
ActiveSheet.Unprotect
Range("B6:G100").ClearContents
Sheets("Adresseneingabe").Activate
Dim objRang As Range
Set objRang = ActiveSheet.Range(Cells(2, 1), _
Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
Application.ScreenUpdating = False
With ActiveSheet
For Each c In objRang
If c = "a" Then
.Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy _
Destination:=Worksheets("Zuordnungstabelle").Cells(Sheets(" _
Zuordnungstabelle"). _
Cells(Rows.Count, 5).End(xlUp).Row + 1, 2)
End If
Next
End With
Sheets("Zuordnungstabelle").Activate
Application.ScreenUpdating = True
End Sub
Um Fehler durch neue Spalten zu umgehen, stelle ich mir vor, die Übertragung abhängig von der Spaltenüberschrift zu machen. Diesbezüglich hatte ich im Netz einen Code gefunden, der die Werte abhängig von der Spaltenüberschrift zuordnet. Ich hatte es versucht, die beiden Codes miteinander zu verquicken, bin aber kläglich gescheitert, zumal ich nicht den ganzen Code aus dem Netz verstehe (siehe Beispieldatei).
Anbei eine Beispieldatei: https://www.herber.de/bbs/user/72339.xls
Kann mir heute jemand helfen?
Gruß
Tobias

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Werte abhängig von Spaltenbezeichnung kopieren
18.11.2010 07:50:23
Spaltenbezeichnung
Guten Morgen Lutz,
vielen Dank dass Du Dich meinem Problem angenommen hast.
Dein Code funktioniert einwandfrei, auch wenn ich in "Adresseneingabe" neue Spalten einfüge.
Eine Einschränkung: Der Code funktioniert nur aus "Adresseingabe" heraus, ich würde aber lieber aus "Zuordnungstabelle" heraus den Code starten. Habe es mit Sheets(xyz).Activate am Anfang und Ende versucht (siehe nachstehend), aber dann erhalte ich die Fehlermeldung "400"!? - und ich dachte, so langsam habe ich einige Grundzüge des VBA verstanden :-(
Könntest Du mir hierbei auch noch helfen?
Sub uebertragen()
Dim rng1 As Range
Dim lngz1 As Long
Dim lngz2 As Long
Dim lastRow As Long
Dim lastCol As Integer
Dim intz1 As Integer
Dim intz2 As Integer
Application.ScreenUpdating = False
Sheets("Adresseneingabe").Activate 'hat strodti eingefügt
'Bereich ermitteln
lastRow = Me.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Me.Cells(1, Columns.Count).End(xlToLeft).Column
'Zeilen in Adresseingabe durchlaufen
lngz2 = 5
For lngz1 = 2 To lastRow
'Daten nur übernehmen, wenn in Spalte 1 "a"
If Me.Cells(lngz1, 1).Value = "a" Then
lngz2 = lngz2 + 1
'Spalten in Zuordnungstabelle durchlaufen
intz2 = 1
For intz1 = 2 To 33 'Spaltenüberschriften vergleichen
Do Until UCase(Me.Cells(1, intz2)) Like UCase(Worksheets("Zuordnungstabelle"). _
Cells(5, intz1))
intz2 = intz2 + 1
If intz2 = lastCol Then Exit Do 'Spaltenüberschrift nicht gefunden
Loop
'Daten kopieren
Me.Cells(lngz1, intz2).Copy _
Destination:=Worksheets("Zuordnungstabelle").Cells(lngz2, intz1)
Next
End If
Next lngz1
Sheets("Zuordnungstabelle").Activate 'hat strodti eingefügt
Application.ScreenUpdating = True
End Sub
MfG
Tobias
Anzeige
AW: Werte abhängig von Spaltenbezeichnung kopieren
18.11.2010 09:53:53
Spaltenbezeichnung
Hallo Tobias,
Der Code muss in ein allg. Modul und nicht in das Klassenmodul des Workbooks (wie in deinem Bsp) und auch nicht das Klassenmodul der Worksheets (wie im Bsp von Lutz).
Dann kannst du diesen aufrufen, egal wo fu grade stehst.
Lutz bezieht sich allerdings mit "Me" auf das Tabellenblatt, in dessen Klassenmodul er der Code eingefügt hat. Das musst du dann noch anpassen.
Auf Activate kann man ganz verzichten.
Ebenso ist es nicht notwendig zu kopieren. Hier ist es sinnvoll, nur den "Value" zu übernehmen.
Der Like-Operator macht IMO hier auch kein Sinn.
Gruß
Christian
Anzeige
AW: Werte abhängig von Spaltenbezeichnung kopieren
18.11.2010 10:05:59
Spaltenbezeichnung
Hallo Christian,
danke für Deinen Beitrag. Den ersten Teil verstehe ich, aber dann...
Lutz bezieht sich allerdings mit "Me" auf das Tabellenblatt, in dessen Klassenmodul er der Code eingefügt hat. Das musst du dann noch anpassen.
Anpassen: Ich würde jetzt Me durch Sheets("Adresseneingabe") ersetzen - richtig?
Aber anschließend folgt "lngz2 = 5" - wie sage ich hier, dass (was auch immer hier geschieht) in "Adresseneingabe" zu erfolgen hat?
Auf Activate kann man ganz verzichten.

Kann ich das nicht einsetzen, um obiges zuzuweisen?
Ebenso ist es nicht notwendig zu kopieren. Hier ist es sinnvoll, nur den "Value" zu übernehmen.
Der Like-Operator macht IMO hier auch kein Sinn.

sorry - nicht verstanden.
Habe leider wirklich einige Verständnisschwierigkeiten, aber ich möchte es verstehen (und daraus lernen).
Gruß
Tobias
Anzeige
AW: Werte abhängig von Spaltenbezeichnung kopieren
18.11.2010 10:22:58
Spaltenbezeichnung
ja, mit Ersetzen von "Me" durch "Sheets("Adresseneingabe")" liegst du richtig.
lngz2 ist die Startzeile mit den Überschriften in der Zuordnungstabelle.
Diese Variable wird in der Schleife hochgezählt und mit:
Me.Cells(lngz1, intz2).Copy Worksheets("Zuordnungstabelle").Cells(lngz2, intz1)
wird der Wert aus Adresseneingabe in die nächste Zeile "lngz2" von Zuordnungstabelle kopiert.
hier kann man aber auf Copy verzichten, wenn man die ganzen Zellformate nicht benötigt, sondern nur den Wert.
zB mit:
Me.Cells(lngz1, intz2) = Worksheets("Zuordnungstabelle").Cells(lngz2, intz1).Value
In diesen Beispielzeilen ist das "Me" natürlich noch falsch, aber das hatten wir ja schon.
Gruß
Christian
Anzeige
Danke Christian und Lutz
18.11.2010 10:59:39
strodti
Hallo Christian,
habe jetzt alle "Me" durch "Worksheets("Adresseneingabe")" ersetzt - und es funktioniert.
Der Code ist noch im Klassenmodul des Worksheets - solange es funktioniert ist es mir recht.
Die Unterschiede der verschiedenen Module muss ich mir noch erschließen.
Deine anderen Hinweise und Tipps (statt copy .value) werde ich nochmal ausprobieren. Vorerst lasse ich den Code so, wie Lutz ihn erstellt hat.
Danke Euch beiden für die Hilfe, Hinweise und Anregungen und für Eure Zeit.
Mit freundlichen Grüßen
Tobias
AW: Danke Christian und Lutz
18.11.2010 11:07:50
Christian
der Vollständigkeit halber hier mein Vorschlag (wie gesagt muss der Code in ein Allg. Modul - im VBA-Editor "einfügen - Modul")
Gruß
Christian
Option Explicit
Sub uebertragen()
Dim wksSrc As Worksheet
Dim wksDst As Worksheet
Dim hshCap As Object
Dim i&, j&, vntKey
Dim strCap$, strErr$
Dim blnFnd As Boolean
Dim blnErr As Boolean
Const CAPROWSRC As Long = 1     'Überschrift-Zeile in Quell-Datei
Const CAPROWDST As Long = 5     'Überschrift-Zeile in Ziel-Datei
Const CAPCOLSRC As Long = 1     'Überschrift-Spalte in Quell-Datei
Const CAPCOLDST As Long = 2     'Überschrift-Spalte in Ziel-Datei
Set wksSrc = ThisWorkbook.Sheets("Adresseneingabe")
Set wksDst = ThisWorkbook.Sheets("Zuordnungstabelle")
Set hshCap = CreateObject("Scripting.Dictionary")
With wksDst
'prüfe Überschriften
For i = CAPCOLDST To .Cells(CAPROWDST, Columns.Count).End(xlToLeft).Column
strCap = Trim(UCase(.Cells(CAPROWDST, i)))
blnFnd = False
For j = CAPCOLSRC To wksSrc.Cells(CAPROWSRC, Columns.Count).End(xlToLeft).Column
If Trim(UCase(wksSrc.Cells(CAPROWSRC, j))) = strCap Then
hshCap(j) = i
blnFnd = True
Exit For
End If
Next
If Not blnFnd Then
strErr = strErr & strCap & vbLf
blnErr = True
End If
Next
'Abbruch bei fehlenden Feldern
If blnErr Then
MsgBox "fehlende Felder in " & wksSrc.Name & vbLf & strErr, 16, "Fehler"
Exit Sub
End If
'Daten übertragen
j = CAPROWDST
For i = CAPROWSRC + 1 To wksSrc.Cells(Rows.Count, CAPCOLSRC).End(xlUp).Row
If wksSrc.Cells(i, CAPCOLSRC) = "a" Then
j = j + 1
For Each vntKey In hshCap.Keys
.Cells(j, hshCap(vntKey)) = wksSrc.Cells(i, vntKey)
Next
End If
Next
End With
Set wksSrc = Nothing
Set wksDst = Nothing
Set hshCap = Nothing
End Sub

Anzeige
AW: Danke Christian und Lutz
18.11.2010 11:17:36
strodti
Hi Christian,
vielen Dank für den Code - und so viele neue Eindrücke. Da werde ich mich mal durchwühlen.
Abermals ein großes Dankeschön.
Gruß
Tobias
Codeerläuterung
18.11.2010 08:07:12
strodti
Hi Lutz,
irgendwie verstehe ich den Code nicht.
a) Bereich ermitteln: ok versehe ich, aber wo wird im nachfolgenden Code darauf Bezug genommen?
b)Was bedeutet lngz2 = 5
c) Spalten in Zuordnungstabelle durchlaufen: woher weiß der Code, dass jetzt ein anderes tabellenblatt gemeint ist (hat das mit der "1" bzw "2" am Ende einer Variablen zu tun? für Tabelle1 bzw. Tabelle2?
d) Über Destination werden dann die Werte der "Zuordnungstabelle" zugeordnet: genau wie in c) Wo ist der Tabellenwechsel im Code.
Bitte hilf mir Deinen Code zu verstehen. Vielleicht interpretiere ich den code ja auch völlig verkehrt.
Hab Geduld mit mir.
MfG
Tobias
Anzeige
AW: Codeerläuterung
18.11.2010 20:41:10
Lutz
Hallo strodti,
Christian hat mit seinen Anmerkungen natürlich zum Tiel recht, in der beiliegenden Arbeitsmappe habe ich die Funktionen kurz beschrieben. Falls Du noch Fragen haben solltes, melde Dich bitte noch mal.
https://www.herber.de/bbs/user/72368.xlsm
M.f.G.
Lutz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige