online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon wnpr vom 13.03.2019, 16:28 Options

Datenuebernahme in Excel

Hallo zusammen!
Ich habe folgendes Problem:
2 Exceltabellen (TAund TB)
TA enthält eine Spalte A mit Namen
TB enthält eine Spalte C mit Namen
Es sollen für alle Zeilen der Spalte A aus Tabelle TA in der Tabelle TB Spalte C die korrespondierenden Namen gefunden werden. Wird ein solcher gefunden sollen die Cellwerte aus den (vorher) definiert Spalten der Tabelle TB in (vorher) definierte Cellen der Tabelle TA übernommen werden (nicht verknüpft).
Ich möchte damit die Möglichkeit erhalten aus vorhandenen Exceltabellen Werte in eine neue Tabelle zu übernehmen.
Danke
Wolfram


Antwort schreiben

Antwort 1 von Saarbauer vom 14.03.2019, 08:11 Options

Hallo,

etwas schwer verständlich, aber so wie ich es verstehe ist es nur mit VBA zu machen

Kannst du hier

http://www.netupload.de/

mal eine Beispieldatei einstellen und den Link hier hinterlegen


Gruß

Helmut

Antwort 2 von wnpr vom 14.03.2019, 09:31 Options

Hallo Helmut!

Danke das du dich meines problems annimmst.
Hier der Link zur Beispieldatei

http://www.netupload.de/detail.php?img=f1329568213095bb22a35bd80809abc0.xls

Ich hoffe es macht mein Problem etwas anschaulicher.

Gruß

Wolfram

Antwort 3 von coros vom 14.03.2019, 11:02 Options

Hallo Wolfram,

ich habe Dir mal ein Beispielmakro erstellt, dass das was Du Dir vorgestellt hattest, machen sollte. Kopiere es in ein StandardModul und starte es.

[b]Option Explicit

Sub Daten_prüfen()
Dim iDat1 As Long, iDat2 As Long, firstRow As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Application.ScreenUpdating = False
Set wks1 = Workbooks("Datei1.xls").Sheets("Tabelle1")
Set wks2 = Workbooks("Datei2.xls").Sheets("Tabelle2")

For iDat1 = 4 To wks1.Range("A65536").End(xlUp).Row
    For iDat2 = 4 To wks2.Range("B65536").End(xlUp).Row
        If wks1.Cells(iDat1, 1) = wks2.Cells(iDat2, 2) Then
            wks2.Cells(iDat2, 4) = wks1.Cells(iDat1, 3)
            GoTo Weiter
        End If
    Next
    firstRow = wks2.Range("B65536").End(xlUp).Offset(1, 0).Row
    With wks2
        .Cells(firstRow, 2) = wks1.Cells(iDat1, 1)
        .Cells(firstRow, 4) = wks1.Cells(iDat1, 3)
        .Cells(firstRow, 4).Font.ColorIndex = 3
        .Cells(firstRow, 4).Font.Bold = True
    End With
Weiter:
Next
End Sub[/b]


Bei dem Makrto werden die Daten aus Tabelle1 aus der 1. Datei mit den Daten aus Spalte B in der 2. Datei verglichen. Wenn eine Übereinstimmung gefunden wurde, werden die Daten aus Datei 1 Spalte C in Datei 2 in Spalte D eingetragen. Wurde der Name nicht gefunden, wird der Name mit den Daten aus Spalte C in Datei 2 am Ende eingefügt.

Bedingung bei dem Makro ist, dass beide Dateien geöffnet sind. Du musst in dem Makro in den Zeilen

[b]Set wks1 = Workbooks("Datei1.xls").Sheets("Tabelle1")
Set wks2 = Workbooks("Datei2.xls").Sheets("Tabelle2")[/b]


den Datei- und Blattnamen noch anpassen.

Ich hoffe, Du meintest das so. Bei Fragen melde Dich bitte wieder.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Ähnliche Themen

symbolleisten in excel
luisa  14.01.2007 - 253 Hits - 4 Antworten

Excel - Symbolleiste speichern - Datei excel*.xlb fehlt
a_wurm  07.08.2007 - 237 Hits - 2 Antworten

Excel 2002 Dateien in Excel 2007 für MS Vista Home Premium
1tiggy  09.11.2007 - 180 Hits - 5 Antworten

Absturz von Powerpoint UND Excel
RalfH  22.11.2007 - 144 Hits -

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Mon Jan 26 01:23:17 2026