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

GleicheFeldnamen Automatisch erkennen und kopieren

GleicheFeldnamen Automatisch erkennen und kopieren
01.02.2006 10:43:54
Sebastian
Hallo, ich habe folgendes Problem :
Ich habe 2 Excel Tabellen.
Beide Tabellen haben die gleichen Feldnamen.
Die 1. Excel Tabelle wird vom System immer automatisch generiert.
Die 2. Excel Tabelle ist eine selber erstellte Datei, inder ich die vom System generierte Tabelle analysieren bzw. veranschaulichen möchte. (mit Makro)
Jetzt möchte ich eine Übersicht machen, indem ich aus der SYSTEM Tabelle einzelne Felder rauskopiere und in meine Übersicht Tabelle reinkopiere.
Das ganze ist im moment so realisiert :
Workbooks.Open Filename:=Datname
Workbooks(Datnametemp).Worksheets("Uebersicht").Range("Artikelnummer").Value = _
Workbooks(Datname).Worksheets("Kalkulation").Range("Artikelnummer").Value
usw..
funktionieren tut es, einziger Nachteil es ist eine Mords schreibarbeit alle Feldnamen immer von der Einen Tabelle in die andere zu kopieren.
Jetzt meine Frage: Da die Feldnamen in beiden Tabellen gleich sind, gibt es da nicht eine Möglichkeit die automatisch zuordnen zu lassen ?!
Gruß

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 11:02:36
Josef
Hallo Sebastian!
Ungetestet!
Dim objName As Name

On Error Resume Next
For Each objName In Workbooks(Datname).Names
  Workbooks(Datnametemp).Names(objName.Name).Value = objName.Value
Next
On Error GoTo 0

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 11:38:26
Sebastian
Hallo Sepp,
danke für deine schnelle Antwort.
Das Ergebnis ist im moment so, das er mir mit dem Code leider nur die Excel Dateinamen reinkopiert.
Aber der weg ist sicher schon der richtige ...
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 11:38:38
Sebastian
Hallo Sepp,
danke für deine schnelle Antwort.
Das Ergebnis ist im moment so, das er mir mit dem Code leider nur die Excel Dateinamen reinkopiert.
Aber der weg ist sicher schon der richtige ...
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 11:38:42
Sebastian
Hallo Sepp,
danke für deine schnelle Antwort.
Das Ergebnis ist im moment so, das er mir mit dem Code leider nur die Excel Dateinamen reinkopiert.
Aber der weg ist sicher schon der richtige ...
Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 11:51:21
Josef
Hallo Sebastian!
Sub CopyNameRange()
Dim objName As Name

On Error Resume Next
With Workbooks(Datname)
  For Each objName In .Names
    Workbooks(Datnametemp).Worksheets("Uebersicht").Range(objName.Name).Value = _
      .Worksheets("Kalkulation").Range(objName).Value
  Next
End With
On Error GoTo 0

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 12:34:03
Sebastian
Hallo Sepp,
er kopiert immer noch die Dateinamen nur.
Im Einzelschrittmodus sagt er mir, ObjName = Nothing
und er springt zum error über ...
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 12:46:51
Josef
Hallo Sebastian!
Ein ".Name" hat gefehlt!
With Workbooks(Datname)
  For Each objName In .Names
    Workbooks(Datnametemp).Worksheets("Uebersicht").Range(objName.Name).Value = _
      .Worksheets("Kalkulation").Range(objName.Name).Value
  Next
End With

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 12:57:27
Sebastian
Hallo,
ich verstehe es nicht, jetzt läuft er alle FeldNamen durch, als Anzeige sehe ich aber immernoch nur meine Dateinamen.
Wie kann das sein ?! Der Dateiname steht nichtmal irgendwo in der Datei drin.
Gruß
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 13:24:09
Josef
Hallo Sebastian!
Ich hab es jetzt nachgebaut und es läuft ohne Probleme!
Sind die Workbooks richtig referenziert?
Sub CopyNameRange()
Dim objName As Name
Dim Datname As Workbook, Datnametemp As Workbook

Set Datname = Workbooks("Mappe1")
Set Datnametemp = Workbooks("Mappe2")

On Error Resume Next
With Datname
  For Each objName In .Names
    Datnametemp.Worksheets("Uebersicht").Range(objName.Name).Value = _
      .Worksheets("Kalkulation").Range(objName.Name).Value
  Next
End With
On Error GoTo 0

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 13:49:10
Sebastian
Hallo Sepp,
ok, im moment zeigt er mir nur noch den Fehler
Index außerhalb des gültigen Bereichs an bei
'Set Datname = Workbooks("Mappe1")
'Set Datnametemp = Workbooks("Mappe2")
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 14:14:16
Sebastian
Zum Besseren Verständnis habe ich jetzt mal das komplette Makro hier hereinkopiert.
' ******** Globale Variablen
Dim NächsteMappe As Variant
Dim VerzName As Variant
'Dim Datname
'Dim Datnametemp As Variant
Dim GB1
Dim GB2
Dim GB3
Dim GBErgebnis
Dim Datname As Workbook
Dim Datnametemp As Workbook
Dim vhkalkpruef As Boolean
Dim objName As Name

Sub Schleife()
' Verzeichnis Auswahl
Application.GetOpenFilename
Datnametemp = ActiveWorkbook.Name
NächsteMappe = Dir(VerzName & "*.*")
' Schleifenbedingung
Do While NächsteMappe <> ""
Workbooks.Open VerzName & NächsteMappe
Datname = ActiveWorkbook.Name
Call UebergabeKalk
Windows(Datname).Activate
ActiveWorkbook.Close changesave = False
NächsteMappe = Dir()
Loop
Columns("D:E").ColumnWidth = 0.75
MsgBox "Datenimport abgeschlossen!", vbCritical
' Ende 

Sub Schleife
End Sub


Sub UebergabeKalk()
' Prüfungsabfrage ob Datei = Kalkualtion
Datname = ActiveWorkbook.Name
If ActiveWorkbook.Sheets(1).Name = "KALKULATION" Then
vhkalkpruef = True
ActiveWorkbook.Close changesave = False
Datnametemp = ActiveWorkbook.Name
Else
MsgBox "Mappe ist keine Kalkulationsmappe!", vbCritical
Workbooks(Datname).Close False
Datnametemp = ActiveWorkbook.Name
Application.Quit
Workbooks(Datnametemp).Close False
End If
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Range("e1").Value = Datname
' Beginn der Kopfdaten (Verbundene Zellen)
Workbooks.Open Filename:=Datname
'Set Datname = Workbooks("Uebersicht")
'Set Datnametemp = Workbooks("Kalkulation")
On Error Resume Next
With Datname
For Each objName In .Names
Datnametemp.Worksheets("Uebersicht").Range(objName.Name).Value = _
.Worksheets("Kalkulation").Range(objName.Name).Value
Next
End With
On Error GoTo 0

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 16:04:24
Josef
Hallo Sebastian!
Bevor wir hier noch weiter rumstochern, beschreib doch mal genau, was dein Makro machen soll!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 19:29:09
Sebastian
Also, es geht einfach darum:
Das Makro, importiert eine Excel Datei und kopiert aus dem Datenblatt (KALKULATION) der Datei verschiedene Werte in ein neues Datenblatt meiner Datei (UEBERSICHT)
So. Jetzt möchte ich, dass Excel alle Feldnamen die mit meiner Tabelle übereinstimmen aber nicht standard (a1,a2,a3) sind automatisch erkennt und in die neue tabelle (UEBERSICHT) reinkopiert.
Mappe1.xls - Mappe2.xls
Also aus (Kalkulation) - (Uebersicht)
Bsp. Name - Name
Geb - Geb
In beiden Tabellen sind die Feldnamen gleich benannt.
Gruß
Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
01.02.2006 23:20:46
Josef
Hallo Sebastian!
Der Code ist etws wirr, daher weis ich nicht ob ich alles richtig eingestellt habe!
Probier's mal aus.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

' ******** Globale Variablen
Dim NächsteMappe As Variant
Dim VerzName As Variant
Dim GB1
Dim GB2
Dim GB3
Dim GBErgebnis

Sub Schleife()
Dim Datname As Workbook
Dim Datnametemp As Workbook

' Verzeichnis Auswahl
Application.GetOpenFilename
Set Datnametemp = ActiveWorkbook
NächsteMappe = Dir(VerzName & "*.*")

' Schleifenbedingung
Do While NächsteMappe <> ""
  Set Datname = Workbooks.Open(VerzName & NächsteMappe)
  Call UebergabeKalk(Datname, Datnametemp)
  Datname.Close False
  Set Datname = Nothing
  NächsteMappe = Dir()
Loop

Datnametemp.Sheets("Uebersicht").Columns("D:E").ColumnWidth = 0.75
MsgBox "Datenimport abgeschlossen!", vbCritical

' Ende
Set Datnametemp = Nothing
End Sub




Sub UebergabeKalk(objWbSrc As Workbook, objWbTar As Workbook)
Dim objName As Name

' Prüfungsabfrage ob Datei = Kalkualtion
If objWbSrc.Sheets(1).Name <> "KALKULATION" Then
  MsgBox "Mappe ist keine Kalkulationsmappe!", vbCritical
  objWbSrc.Close False
  objWbTar.Close False
  Application.Quit
End If

With objWbTar.Worksheets("Uebersicht")
  Columns("F:F").Insert Shift:=xlToRight
  .Range("e1").Value = objWbSrc.Name
End With

' Beginn der Kopfdaten (Verbundene Zellen)

On Error Resume Next
With objWbSrc
  For Each objName In .Names
    objWbTar.Worksheets("Uebersicht").Range(objName.Name).Value = _
      .Worksheets("Kalkulation").Range(objName.Name).Value
  Next
End With
On Error GoTo 0

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: GleicheFeldnamen Automatisch erkennen und kopi
02.02.2006 07:13:17
Sebastian
Hallo Sepp,
du bist der beste ... es funktioniert einwandfrei.
Wenn ich jetzt noch andere Mappen zu meiner Übersicht hinzufügen möchte, muss ich ja einfach den code
With objWbSrc
For Each objName In .Names
objWbTar.Worksheets("Uebersicht").Range(objName.Name).Value = _
.Worksheets("Kalkulation").Range(objName.Name).Value
von kalkulation in eine andere mappe ändern ?!
vielen dank
gruß

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige