Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1068to1072
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

Daten mit Mrakro aus Arbeitsmappe lesen

Daten mit Mrakro aus Arbeitsmappe lesen
24.04.2009 10:41:22
Martin
Hallo,
ich hatte schon einmal eine Anfrage diesbezüglich hier gepostet und eine Antwort erhalten. Ich habe etwas Zeit benötigt, um mir Gedanken darüber zu machen. Jetzt scheint der alte Thread nicht mehr in der Form hier gespeichert zu sein, dass ich direkt auf ihn antworten kann.
Ich poste daher den alten Thread am Ende dieses Postings.
Ich habe ein Makro, dass Daten aus einer Mappe ausliest und in die aktuelle Mappe übernimmt.
Dazu hätte ich gerne ein paar Hinweise zu Verbesserungen:
1) Zeile 34:
Ich möchte am Ende des Makros einen Dialog aufrufen, der mich entscheiden lässt, wo und unter welchem Namen die aktuelle Arbeistmappe gespeichert wird. Jetzt ist der Name hart kodiert.
2) Zeile 20:
Am Anfang des Makros wird ein Dialog aufgerufen, in dem die Eingabemappe gewählt werden kann. Wie kann ich bei dem Aufruf ein Defaultverzeichnis angeben, in dem die Suche beginnt? Das Verzeichnis soll das gleiche sein, in dem die Arbeitsmappe mit dem Makro liegt.
3) Zeile 13-15:
Gibt es eine "elegantere" Art, die Liste mit den auszulesenden Namen zu füllen?
4) Zeile 27:
Wie kann man elegant prüfen, ob die Namen in beiden Mappen vorhanden sind?
Das Fehlen eines Namens soll keinen Programmabbruch bewirken. AM besten wäre eine Liste der Namen, bei denen der Import nicht funktioniert hat.
Vielen, vielen Dank für eure Zeit, Martin
1

Sub Sammeln1()
2        '
3        ' Sammeln1 Makro
4        '
5
6        '
7   Dim wb1 As Workbook
8   Dim wb2 As Workbook
9   Dim intz As Integer
10
11   Dim Liste(2) As String
12
13  Liste(0) = "name1"
14  Liste(1) = "name2"
15  Liste(2) = "name3"
16
17
18  Set wb1 = ThisWorkbook
19  '--- Dialog für weitere Datei öffnen
20  Application.Dialogs(xlDialogOpen).Show
21  Set wb2 = ActiveWorkbook
22
23  '--- Daten von geöffneter Datei in aktuelle Datei übertragen per Namensbereiche
24
25  For intz = 0 To 2
26
27  wb1.Names(Liste(intz)).RefersToRange.Value = wb2.Names(Liste(intz)).RefersToRange.Value
28
29  Next intz
30  ' --- geöffnete Datei ohne speichern schließen
31  wb2.Saved = True
32  wb2.Close
33  '--- Bestehende Datei unter neuem Namen speichern
34  wb1.SaveAs "NeuerDateiname.xls"
35  End Sub


ALTER THREAD beginnt hier:
Thema: Daten mit Macro aus anserer Arbeitsmappe lesen
* Daten mit Macro aus anserer Arbeitsmappe lesen von Martin Lohner vom 13.04.2009 23:43:58
o AW: Daten mit Macro aus anserer Arbeitsmappe lesen - von Daniel am 14.04.2009 01:45:55
Ich möchte Daten (einfache Zahlenwerte aus Zellen) in eine Arbeitsmappe übernehmen.
Die Übernahme soll durch ein Befehlsknopf ausgelöst werden.
Die Zellen in der Eingabemappe und der Arbeitsmappe sollen über ihren Namen angesprochen werden.
Den logischen Ablauf stelle ich mir so vor:
-Makro starten
-über eine Box die Eingabemappe auswählen (Defaultanzeige: das Verzeichnis in den die Arbeitsmappe liegt, Defaultdatei "Eingabe.xls, falls existent)
-Eingabemappe öffnen, die Zellen auslesen und an die Zielzelle der Arbeitsmappe schreiben
for i in preis1, preis2, datum1, datum2,.... do
lese i aus Eingabemappe und schreibe i in Arbeitsmappe
done
-Neuberechnung der Arbeitsmappe mit den eingelesenen Werten
-speichern der Arbeitsmappe und einem neuen Namen (die Arbeitsmappe ist schreibgeschützt während der Anwendung.
Zur Fehlerbehandlung wäre noch eine Ausgabe der Zellnamen, die ausserhalb bestimmter Werte liegen oder gar nicht gesetzt sind schön. (if inhalt is not numeric or inhalt kleiner 0, then warnmeldung oder defaultwert annehmen)
Ist bestimmt nicht so schwer, wenn man sich ein wenig mit VBA auskennt.
Ich würde mich über einen Beispielcode freuen, der den Wert der Zelle mit Namen "Preis" aus der Eingabemappe in die Zelle mit Namen Preis in der Arbeitsmappe schreibt. Mehr wäre auch schön ;-)
Danke im Voraus, Martin
HI
schau dir das hier mal an:


Sub test()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ThisWorkbook
'--- Dialog für weitere Datei öffnen
Application.Dialogs(xlDialogOpen).Show
Set wb2 = ActiveWorkbook
'--- Daten von geöffneter Datei in aktuelle Datei übertragen per Namensbereiche
wb1.Names("Name1").RefersToRange.Value = wb2.Names("Name1").RefersToRange.Value
'--- geöffnete Datei ohne speichern schließen
wb2.Saved = True
wb2.Close
'--- Bestehende Datei unter neuem Namen speichern
wb1.SaveAs "NeuerDateiname.xls"
End Sub


falls du Verständnisfragen zu den einzelnen Befehlen hast, nutze ruhig auch mal die Excelhilfe.
dazu einfach den Cursor auf den Befehl setzen und F1 drücken.
Gruß, Daniel

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten mit Mrakro aus Arbeitsmappe lesen
24.04.2009 18:23:44
fcs
Hallo Martin,
hier mal eine Variante, die deine Wünsche nach Flexibilität erfüllen sollte.
Gruß
Franz

Sub Sammeln1()
2        '
3        ' Sammeln1 Makro
4        '
5
6        '
7   Dim wb1 As Workbook, wks As Worksheet
8   Dim wb2 As Workbook
9   Dim intz As Integer, objName As Name, strNames As String
10
11   Dim Liste() As String, lauswahl As Long, sPrompt As String, strPfadAkt As String
12
13  Set wb1 = ThisWorkbook
intz = -1
For Each objName In wb1.Names
If InStr(1, LCase(objName.Name), "druckbereich") > 0 _
Or InStr(1, LCase(objName.Name), "print_area") > 0 _
Or InStr(1, LCase(objName.Name), "print_titles") > 0 _
Or InStr(1, LCase(objName.Name), "titelzeilen") > 0 _
Or InStr(1, LCase(objName.Name), "titelspalten") > 0 _
Or InStr(1, LCase(objName.Name), "printtitlerows") > 0 _
Or InStr(1, LCase(objName.Name), "printtitlecolumns") > 0 Then
'diese Namen nicht in Auswahl anzeigen
Else
sPrompt = "Diesen Namen in Liste aufnehemn?" & vbLf & vbLf _
& objName.Name & vbLf & vbLf & "Bei Abbrechen werden Daten geholt!"
lauswahl = MsgBox(Prompt:=sPrompt, Title:="Namen auswählen", _
Buttons:=vbYesNoCancel)
If lauswahl = vbYes Then
intz = intz + 1
ReDim Preserve Liste(0 To intz)
Liste(intz) = objName.Name
ElseIf lauswahl = vbNo Then
'do nothing
ElseIf lauswahl = vbCancel Then
Exit For
End If
End If
Next
14  If intz > -1 Then
15
16
17
18
19    '--- Dialog für weitere Datei öffnen
strPfadAkt = VBA.CurDir 'Aktuelles Verzeichnis merken
VBA.ChDir ThisWorkbook.Path
20    lauswahl = Application.Dialogs(xlDialogOpen).Show
If lauswahl  False Then
21      Set wb2 = ActiveWorkbook
22
23  '--- Daten von geöffneter Datei in aktuelle Datei übertragen per Namensbereiche
24
25      For intz = LBound(Liste) To UBound(Liste)
26        If Not (fncCheckName(wb1, Liste(intz)) = False Or _
fncCheckName(wb1, Liste(intz)) = False) Then
27          wb1.Names(Liste(intz)).RefersToRange.Value = wb2.Names(Liste(intz)).RefersToRange. _
Value
28        End If
29      Next intz
30  ' --- geöffnete Datei ohne speichern schließen
31      wb2.Saved = True
32      wb2.Close
33  '--- Bestehende Datei unter neuem Namen speichern
34      wb1.Activate
Application.Dialogs(xlDialogSaveAs).Show "NeuerDateiname.xls"
End If
'gemerktes Verzeichnis wieder zurücksetzen
VBA.ChDir strPfadAkt
End If
35  End Sub
Function fncCheckName(wb As Workbook, strName As String) As Boolean
Dim objNamen As Name
For Each objNamen In wb.Names
If strName = objNamen.Name Then
fncCheckName = True
Exit For
End If
Next
If fncCheckName = False Then
MsgBox "Name: """ & strName & """ in Datei """ & wb.Name & """ nicht vorhanden!"
End If
End Function


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige