Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1228to1232
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

Pfadanpassung

Pfadanpassung
Ernst
Schönen Guten Morgen !
ich habe folgendes bestehende Makro das sehr gut funktioniert.
in meiner bestehenden Mappe wird (Zum Eingabewert zugeorneter Wert in Tabelle2 Spalte BTabellenblatt 2) abgefragt.
ich habe aus Tabellenblatt 2 eine eigene Mappe erstellt . "z:\test\Tabelle2"
könnte mir jemand mein bestehendes Makro an diesen Pfad anpassen .
wäre für Lösungsvorschläge dankbar.
lg.Ernst

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSpalte   As Variant  ' die Eingabe- und die zu vergleichenden Spalten
Dim iIndex    As Integer  ' Index für den Spalten-Array
Dim MyFind As Range       ' zum Suchen in der Tabelle
Dim MyText As String      ' fuer die MagBox
Dim sZugeordnet As String ' Einer Eingabespalte zugeordneter Wert
Dim iCount As Integer     ' Anzahl Fundstellen in einer Eingabespalte
If Target.Count > 1 Then Exit Sub   ' mehr als eine Zelle markiert ?
If Target.Value = "" Then Exit Sub  ' ist die Zelle gefüllt ?
'                  B  C  I   J   P   Q
iSpalte = Array(2, 3, 9, 10, 16, 17) ' die Spalten-Nummern als Array
If Target.Column = 2 Or Target.Column = 3 Or _
Target.Column = 9 Or Target.Column = 10 Or _
Target.Column = 16 Or Target.Column = 17 Then  ' eine gültige Eingabe-Spalte ?
'Zum Eingabewert zugeorneter Wert in Tabelle2 Spalte B
With ThisWorkbook.Sheets("Tabelle2").Range("A1:A100").Cells
Set MyFind = .Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
End With
If MyFind Is Nothing Then
sZugeordnet = ""
MyText = ""
Else
sZugeordnet = MyFind.Offset(0, 1)
MyText = "Zugeordneter Wert: " & sZugeordnet
End If
For iIndex = 0 To UBound(iSpalte)          ' alle Spalten abarbeiten/vergleichen
'Zählen des Eingabewertes in Spalte iIndex
iCount = Application.WorksheetFunction.CountIf(Columns(iSpalte(iIndex)), _
Target.Value)
If iCount > IIf(Target.Column = iSpalte(iIndex), 1, 0) Then
MyText = MyText & IIf(MyText = "", "", Chr(10)) _
& "Die Eingabe """ & Target.Value & """ gibt es " _
& "in der Spalte """ & Chr(Asc("@") + iSpalte(iIndex)) _
& """ und in Tabelle2 bereits." & Chr(10) & vbCrLf _
& "Wollen Sie den Eintrag trotzdem übernehmen?"
If MsgBox(MyText, 36, "    nur zur Sicherheit.") = vbYes Then
MyText = "":    Exit For
Else
Target.Value = ""                       ' die Eingabe löschen
Cells(Target.Row, Target.Column).Select ' Cursor auf die Eingabezelle
MyText = "":    Exit For
End If
End If
Next iIndex
If MyText  "" Then MsgBox MyText, vbInformation, _
Target.Value & " - Anzeige zugeordneter Wert"
End If
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Pfadanpassung
26.09.2011 09:53:17
Dirk
Hallo Ernst,
kann man machen. Zu beachten ist aber das dann dieses Blatt/Tabelle auch geoeffnet ist, wenn Du Dein Makro abarbeitest.
Wiist Du das so?
Gruss
Dirk aus Dubai
AW: Pfadanpassung
26.09.2011 10:15:48
Ernst
Hallo Dirk
wenn die Abarbeitung des Makros beendet ist sollte sich Mappe Test Tabellenblatt 2 wieder schließen.
lg.Ernst
AW: Pfadanpassung
26.09.2011 11:12:33
Ernst
Hallo Dirk
habe mir das nochmals überlegt es würde auch reichen wenn meine bestehende Abfrage
Damit meine ich ich lasse Tabellenblatt 2 wie gehabt in meiner Mappe.
beim öffnen meiner Arbeitsmappe (aus neuer Mappe "z:test\Tabelle 2" .(Range a1:a100)aktualisieren.
lg.Ernst
Anzeige
AW: Pfadanpassung
26.09.2011 11:25:30
Dirk
Hallo Ernst,
Der erste Satz Deiner Antwort ist unvollstaendig. Kannst Du nochmal beschreiben, was reichen wuerde?
Gruss
Dirk aus Dubai
AW: Pfadanpassung
26.09.2011 11:38:30
Ernst
Hallo Dirk
habe mir das nochmals überlegt es würde auch reichen wenn meine bestehende Abfrage
'Zum Eingabewert zugeorneter Wert in Tabelle2 Spalte B
With ThisWorkbook.Sheets("Tabelle2").Range("A1:A100").Cells
Damit meine ich ich lasse Tabellenblatt 2 wie gehabt in meiner Mappe.
wenn ich nun meine Mappe öffne sollten sich angegebene Rangebereiche
(aus neuer Mappe "z:test\Tabelle 2" .(Range a1:a100) in meiner bestehenden Tabelle 2aktualisiern.
Ich hoffe das ist einigermaßen verständlich.
lg.Ernst
Anzeige
AW: Pfadanpassung
26.09.2011 12:14:04
Dirk
Hallo Ernst,
kopiere mal das Makro in DieseArbeitsmappe

Private Sub Workbook_Open()
'Hier das Makro zum Aktualisieren der Tabelle2
'erst pruefen, ob Ursprungstabelle schon geoeffnet ist
Dim WB As Workbook
Dim Usersel As String
Dim SourcePath As String
Dim SourceName As String
Dim SourceExt As String
Dim WarOffen As Boolean
'Pfad und Ursprungsdateiname setzen
SourcePath = "z:test"
SourceName = "Tabelle2"
SourceExt = ".xls"
For Each WB In Application.Workbooks
If WB.Path = SourcePath Then
If WB.Name = SourceName & SourceExt Then
'Ursprungstabelle ist schon geoeffnet
WarOffen = True
GoTo Aktualisieren
End If
End If
Next WB
'Ursprungstabelle noch nicht geoffnet, oeffne diese
Aktualisieren:
Usersel = MsgBox("Tabelle2 aktualisieren?", 36, "Benutzerentscheidung")
If Usersel  vbYes Then
MsgBox "Aktualisierung abgebrochen"
If WarOffen = False Then
Application.EnableEvents = False
Application.DisplayAlerts = False
WB.Close False
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
Exit Sub
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=SourcePath & "\" & SourceName
Set WB = ActiveWorkbook
ThisWorkbook.Sheets("Tabelle2").Range("A1:A100").Value = WB.Sheets(SourceName).Range("A1:A100"). _
Value
If WarOffen = False Then
Application.EnableEvents = False
Application.DisplayAlerts = False
WB.Close False
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub

Du musst fuer den Pfad, den Tabellennamen und die Dateiendung entsprechend Deinen Werten anpassen.
Lass' hoeren, ob ok.
Gruss
Dirk aus Dubai
Anzeige
AW: Pfadanpassung
26.09.2011 13:33:07
Ernst
Hallo Dirk
das passt soweit .
jedoch ist dem Wert in Range ("A1:A100")
ein Text zugeordnet der inRange ("b1:b100") steht.
("b1:b100")wird nicht aktualisiert.
weiters ist eine msg box Abfrage nicht erforderlich. soll im Hindergrund aktualisiert werden.
dann wärs perfekt.
lg.Ernst
Danke:-)
26.09.2011 14:06:29
Ernst
Hallo Dirk
Recht herzlichen Dank !
es funktioniert jetzt so wie ich es benötige.
ich hoffe ich habe es richtig verändert.
lg.Ernst

Private Sub Workbook_Open()
'Hier das Makro zum Aktualisieren der Tabelle2
'erst pruefen, ob Ursprungstabelle schon geoeffnet ist
Dim WB As Workbook
Dim Usersel As String
Dim SourcePath As String
Dim SourceName As String
Dim SourceExt As String
Dim WarOffen As Boolean
'Pfad und Ursprungsdateiname setzen
SourcePath = "z:test"
SourceName = "Tabelle2"
SourceExt = "Tabelle2.xls"
For Each WB In Application.Workbooks
If WB.Path = SourcePath Then
If WB.Name = SourceName & SourceExt Then
'Ursprungstabelle ist schon geoeffnet
WarOffen = True
GoTo Aktualisieren
End If
End If
Next WB
'Ursprungstabelle noch nicht geoffnet, oeffne diese
Aktualisieren:
Application.EnableEvents = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=SourcePath & "\" & SourceName
Set WB = ActiveWorkbook
ThisWorkbook.Sheets("Tabelle2").Range("A1:B100").Value = WB.Sheets(SourceName).Range("A1:B100"). _
_
Value
If WarOffen = False Then
Application.EnableEvents = False
Application.DisplayAlerts = False
WB.Close False
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige