Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Excel Makro zum Einfügen von Daten aus anderen Excel Dateien

Frage Microsoft Microsoft Office

Mitglied: Tom77777

Tom77777 (Level 1) - Jetzt verbinden

06.11.2014, aktualisiert 12.11.2014, 3284 Aufrufe, 4 Kommentare

Hallo,
ich bin neu hier im Forum und kenne mich leider nicht so gut mit Excel/VBA aus.

Im Zuge eines Versuchs während meines Maschinenbaustudiums muss wöchentlich Excel Ausleitungen von anderen Programmen in eine Masterdatei einfügen. Es gibt jeweils 2 Ausleitungen welche unterschiedliche Daten enthalten.
Um dies für meine Nachfolger möglichst einfach zu gestalten, möchte ich gerne ein Makro in die Masterdatei einfügen.

Mein Problem/ Anliegen:
Ich habe eine bestehende Excel Datei "A", diese bestehende Datei besitzt in den ersten zehn Zeilen einen Kopf, bzw. Auswertungsformeln, in [A13:A276] sind Einträge vorhanden. Die Einträge sind z.B. AB123F, B354CD usw..

Weiter rechts, also in Spalte B:F sollen Daten von zwei anderen Excel Dateien, "B" und "C" importiert werden.
Ab Spalte G sind manuell eingetragene Werte, welche [A13:A276] zugeordnet sind, diese dürfen nicht verloren gehen, oder umsortiert werden.

Die Werte der Spalten B und D sollen von Excel Datei "B" und die Werte der Spalten C, E, F sollen von Excel Datei "C" importiert werden.

Die Excel Dateien "B" und "C" sollten die bereits vorhandenen Einträge von "A" enthalten, können unter Umständen aber auch abweichen.

Es sollen also Daten entsprechend den Einträgen in der Spalte A, der Masterdatei "A" eingelesen werden. Wenn in "A" [A13], AB123F enthalten ist, sollen die Dateien "B" und "C" durchsucht werden. Bei Übereinstimmung soll die jeweilige Zeile, somit auch die jeweilige Spalte ausgelesen und in die passende Zeile der Masterdatei eingefügt werden.

In der Datei "B" stehen in den Spalten D und E die relevanten Einträge, in der Datei "C" in den Spalten E, J, und K.


Es ist wichtig dass die Reihenfolge der Einträge in der Spalte A bei "A", "B" und "C" übereinstimmt, da ansonsten die Zuordnung der manuell eingetragenen Daten nicht mehr übereinstimmt.

Bei Abweichung wäre es gut wenn eine Fehlermeldung erscheint.

Die beiden Excel Dateien "B" und "C" möchte ich gerne manuell, über ein Suchfenster auswählen.



Vielen vielen Dank für die Hilfe und schöne Grüße aus Bayern
Tom
Mitglied: Eintagsfliege
07.11.2014 um 12:38 Uhr
Hallo Tom!

Es ist wichtig dass die Reihenfolge der Einträge in der Spalte A bei "A", "B" und "C" übereinstimmt, da ansonsten die Zuordnung der manuell eingetragenen Daten nicht mehr übereinstimmt.
Soll heißen, dass die Sucheinträge in den Dateien A/B/C die gleiche Zeilennummer haben müssen oder wie ist das zu verstehen?

Grüße Dieter
Bitte warten ..
Mitglied: Tom77777
07.11.2014 um 14:30 Uhr
Hallo Dieter,
Danke für deine Antwort!
Es ist nur wichtig dass die Einträge den richtigen Zeilen in Dokument A, der Masterdatei zugeordnet werden.
Datei A: zum Beispiel Motor 1 mit Einträgen in der selben Zeile weiter rechts, die zu dem Motor gehören.
Datei B: in irgend einer Zeile steht Motor 1, mit entsprechenden Einträgen in der selben Zeile weiter rechts.
Datei C: analog zu Datei B

-> Einträge sollen den richtigen Zeilen zugeordnet werden.

Viele Grüße
Tom
Bitte warten ..
Mitglied: Eintagsfliege
LÖSUNG 07.11.2014, aktualisiert 12.11.2014
Hallo Tom!

OK, unter der Annahme, dass sich die Daten in allen Arbeitsmappen im Sheet(1) befinden, sollte es mit diesem Code funktionieren:
01.
Option Explicit 
02.
 
03.
Private Const RowStartA = 13                'Daten ab Zeile 13 
04.
 
05.
Private Const ColDataA = "B:F"              'Daten(A): B:F 
06.
Private Const ColDataB = "D,B,E,D"          'Daten(B): D->B, E->D 
07.
Private Const ColDataC = "E,C,J,E,K,F"      'Daten(C): E->C, J->E, K->F 
08.
 
09.
Public Sub DataImport() 
10.
    Dim oWkbB As Workbook, oWkbC As Workbook 
11.
    Dim oWksA As Worksheet, oWksB As Worksheet, oWksC As Worksheet 
12.
    Dim sFileB As Variant, sFileC As Variant 
13.
    Dim oCell As Range, oCells As Range, oFound As Range 
14.
     
15.
    'Wahlweise einen anderen Ordnerpfad in Form "X:\Folder" angeben 
16.
    ChDir ThisWorkbook.Path 
17.
     
18.
    'Import-Dateiauswahl(B/C) *.xlsx-Dateien, bei Bedarf entsprechend anpassen 
19.
    sFileB = Application.GetOpenFilename("Excel-Datei(B) (*.xlsx), *.xlsx") 
20.
    sFileC = Application.GetOpenFilename("Excel-Datei(C) (*.xlsx), *.xlsx") 
21.
     
22.
    If sFileB = False Or sFileC = False Then 
23.
        MsgBox "Dateiauswahl unvollständig!", vbInformation, "Dateiauswahl . . ." 
24.
        Exit Sub 
25.
    End If 
26.
     
27.
    Set oWkbB = GetObject(sFileB)           'Set/Open Datei(B) 
28.
    Set oWkbC = GetObject(sFileC)           'Set/Open Datei(C) 
29.
     
30.
    Set oWksA = ThisWorkbook.Sheets(1)      'Set Workbook(A)-Sheet1 
31.
    Set oWksB = oWkbB.Sheets(1)             'Set Workbook(B)-Sheet1 
32.
    Set oWksC = oWkbC.Sheets(1)             'Set Workbook(C)-Sheet1 
33.
 
34.
    With oWksA  'Daten-Bereich festlegen (A13:A??) 
35.
          Set oCells = .Range(.Cells(RowStartA, "A"), .Cells(RowStartA, "A").End(xlDown)) 
36.
    End With 
37.
 
38.
    Application.ScreenUpdating = False 
39.
     
40.
    For Each oCell In oCells    'Alle Zellen(A13:A??) durchlaufen 
41.
        If oCell.Text <> "" Then 
42.
            With oWksA.Rows(oCell.Row)  'Aktuelle Zeile Spalte(B:F) Inhalte löschen 
43.
                .Columns(ColDataA).ClearContents 
44.
            End With 
45.
             
46.
            With oWksB.Columns("A:A")   'Datei(B) Spalte A durchsuchen 
47.
                Set oFound = .Find(oCell.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
48.
            End With 
49.
         
50.
            If Not oFound Is Nothing Then   'Datei(B): Wenn gefunden Daten kopieren 
51.
                Call GetValues(oWksA, oWksB, ColDataB, oCell.Row, oFound.Row) 
52.
            End If 
53.
             
54.
            With oWksC.Columns("A:A")   'Datei(C) Spalte A durchsuchen 
55.
                Set oFound = .Find(oCell.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
56.
            End With 
57.
             
58.
            If Not oFound Is Nothing Then   'Datei(C): Wenn gefunden Daten kopieren 
59.
                Call GetValues(oWksA, oWksC, ColDataC, oCell.Row, oFound.Row) 
60.
            End If 
61.
        End If 
62.
    Next 
63.
     
64.
    oWkbB.Close False   'Datei(B) schließen (speichern=False) 
65.
    oWkbC.Close False   'Datei(C) schließen (speichern=False) 
66.
     
67.
    Application.ScreenUpdating = True 
68.
     
69.
    MsgBox "Fertig!", vbInformation, "Datenimport . . ." 
70.
End Sub 
71.
 
72.
Private Sub GetValues(ByRef oWksA, ByRef oWksX, ByRef sCols, ByVal iRowA As Long, ByVal iRowX As Long) 
73.
    Dim aColumns As Variant, i As Integer 
74.
     
75.
    aColumns = Split(sCols, ",") 
76.
     
77.
    With oWksX.Rows(iRowX) 
78.
        For i = 0 To UBound(aColumns) Step 2 
79.
            oWksA.Cells(iRowA, aColumns(i + 1)).Value = .Columns(aColumns(i)).Value 
80.
        Next 
81.
    End With 
82.
End Sub
Wobei, bei erfolgloser Suche anstatt einer MsgBox die betroffenen Zellen (B:F) Leer sind

Grüße Dieter
Bitte warten ..
Mitglied: Tom77777
12.11.2014 um 10:23 Uhr
Hallo Dieter,
vielen Dank für deine Antwort.
Das Makro funktioniert ohne Probleme ;)

Viele Grüße
Tom
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(2)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
Excel 2010 - Microsoft Excel kann die Daten nicht kopieren (4)

Frage von EDV-Oellerking zum Thema Microsoft Office ...

Microsoft Office
gelöst Office 2010 und einfügen von .pcx Dateien (24)

Frage von DerWoWusste zum Thema Microsoft Office ...

Microsoft Office
Excel VBA "SVERWEIS" über mehrere Dateien in Ordner (2)

Frage von Acht85 zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...