Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1112to1116
1112to1116
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Update funktion

Forumthread: Update funktion

Update funktion
abu
Guten Tag Zusammen,
ich moechte gerne in Excel eine Update-Funktion erstellen. Folgender Grundriss:
Ich ziehe Daten und speicher diese in einem Ordner. Pro Arbeitsmappe ein Arbeitsblatt, Ordnerstruktur wie folgt: Jahr/Woche/ die Arbeitsmappe heisst dann Beispielsweis Montag 45 (45 fuer Woche), Arbeitsblatt heisst genauso.
Dann moechte ich gerne in meiner Arbeitsmappe, in der ich arbeite (per VBA) ein Update einspielen, ungefaehr so:
1. Suche in Ordner 2009 eine Arbeitsmappe die genauso heisst wie das aktive Arbeitsblatt: also fuer das Beispiel "Montag 45"
2. Nehme Zelle F2 (Update) suche in Spalte F ob du das findest, wenn ja dann ueberschreibe x2, y2 und z2
3. wenn nicht dann suche letzte freie Zeile und kopiere komplette Zeile
4. durchlaufe alle Zeilen
Fertig.
Ich denke ab 2. bekomm ich das irgendwie hin aber wie ist der Code fuer 1.
Ueber Unterstuetzung wuerde ich mich freuen.
Gruss Abu
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Update funktion
03.11.2009 13:41:48
Chris
Servus,
zu Punkt 1:
ich würd's mal so probieren:
Sub Datei_vorhanden()
Dim Pfad As String
Dim Fso, DateiName
Set Fso = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\....\2009\" ' Hier deinen Pfad vorgeben
DateiName = Pfad & "\" & ActiveSheet.Name & ".xls"
If Fso.FileExists(DateiName) Then
Workbooks.Open DateiName
Else
MsgBox "nichts da!"
End If
End Sub
Gruß
Chris
Anzeige
AW: Update funktion
03.11.2009 14:19:20
abu
Hallo Chris,
toll, klappt super. Sucht und oeffnet die Datei. Ich denke jetzt muss ich noch Schritt 2 bis 4 schreiben und anschliessend sagen:
Workbooks.Close DateiName ?
Ist es auch meoglich das ganze unsichtbar laufen zu lassen?
Gruss Abu
AW: Update funktion
03.11.2009 15:20:14
abu
Hallo Chris,
hab mir fuer Schritt 2 bis 4 folgendes Makro rausgesucht um es umzustricken... leider bekomm ich das nicht ans laufen. Weisst du warum?
Sub Tabellen_Vergleich07()
'* H. Ziplies                                     *
'* 02.06.07                                       *
'* erstellt von HajoZiplies@web.de                *
'* http://Hajo-Excel.de/
Dim WbO As Worksheet                                        ' Original Datei
Dim WbK As Worksheet                                        ' Kopie Datei
Dim LoI As Long                                             ' 1. Schleifenvariable
Dim LoJ As Long                                             ' 2. Schleifenvariable
Dim LoLetzte1 As Long                                       ' Variable letzte Zeile in  _
Spalte A
Dim LoLetzte2 As Long                                       ' Variable letzte Zeile in  _
Spalte B
Application.ScreenUpdating = False                          ' Bildschirmaktualisierung aus
Set WbO = ActiveSheet
Set WbK = Workbooks("Tuesday 45.xls").Worksheets("Tuesday 45")
With WbO
' letzte belegte Zeile unabhängig von Excelversion für Spalte D (4), es wird davon  _
ausgegangen, dass keine Zeilen ausgeblendet sind
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 4)), .Cells(Rows.Count, 4).End(xlUp).Row, . _
Rows.Count)
End With
With WbK
' letzte belegte Zeile unabhängig von Excelversion für Spalte D (4), es wird davon  _
ausgegangen, dass keine Zeilen ausgeblendet sind
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
For LoI = 1 To LoLetzte1                                    ' 1. Schleife alle Werte Spalte  _
D Original
For LoJ = 1 To LoLetzte2                                ' 2. Schleife alle Werte Spalte  _
A Kopie
If WbO.Cells(LoI, 1)  "" Then                     ' Leerzellen nicht kennzeichnen
If WbO.Cells(LoI, 1) = WbK.Cells(LoJ, 2) Then
WbO.Cells(LoI, 74) = WbK.Cells(LoJ, 7)
End If
End If
Next LoJ
Next LoI
Set WbO = Nothing                                           ' Variable leeren
Set WbK = Nothing                                           ' Variable leeren
Application.ScreenUpdating = True                           ' Bildschirmaktualisierung ein
End Sub
Hab das in deinen Code noch nicht eingebaut um es einfach mal zu testen und zu sehen was ich aendern muss damit es meine Dinge macht. Leider sehe ich null Veraenderung nachdem es durchgelaufen ist.
Gruss Abu
Anzeige
AW: Update funktion
03.11.2009 15:24:49
abu
Frage weiterhin offen. sorry
AW: Update funktion
03.11.2009 17:12:19
Chris
Servus,
ich hab mir das Makro jetzt nicht angeschaut, da ich auch nicht genau weiß, was wohin soll. Erklär mal genauer:
1. Suche in Ordner 2009 eine Arbeitsmappe die genauso heisst wie das aktive Arbeitsblatt: also fuer das Beispiel "Montag 45"
Punkt 1 ist ja klar.
2. Nehme Zelle F2 (Update) suche in Spalte F ob du das findest, wenn ja dann ueberschreibe x2, y2 und z2
Zelle F2 aus welcher Datei, die mit dem Makro, oder die ,die geöffnet wird? Spalte F in welcher Datei soll durchsucht werden ?
3. wenn nicht dann suche letzte freie Zeile und kopiere komplette Zeile
Eintrag in welche Datei? in die mit dem Makro ?
4. durchlaufe alle Zeilen
Suche nach F2, dann F3, dann F4..., oder wie ist das gemeint?
Gruß
Chris
Anzeige
AW: Update funktion
03.11.2009 18:19:19
abu
Hallo Chris,
um es deutlicher zu machen, sagen wir ich hab die update datei die an einem fixen Ort gespeichert ist und ich hab die Datei in der ich arbeite sagen wir die heißt Planung.
Uberigens möchte ich den Code als Addin speichern, ich weiß nicht in wie weit es relevant ist.
Zu 2.: er soll aus der Update Datei jede Zeile durchlaufen, angefangen bei Zeile 2 also Zelle F2. Den Wert soll er in Spalte F in der Datei Planung suchen, wenn er den Wert findet, dann soll er x2, y2, z2 aus Update-Datei nehmen und in Zelle x2, y2, z2 bei Planung reinkopieren (sind natuerlich jetzt ausgedachte Zellen die ich später anpassen werde.
Zu 3.: Wenn er den Wert nicht findet, dann soll er die komplette Zeile von Update in Planung kopieren und zwar ans Ende
Zu.4.: Das soll er für alle Zeilen machen in Update. Also als nächstes F3, suchen ob er den Wert in der Datei Planung, Spalte F findet, wenn ja kopiere von Update datei xyz3 in Datei Planung natürlich auch xyz3.
Eine Zeile ist immer ein Fall und die Daten von Update werden immer nach Planung kopiert, nie umgekehrt.
Gruß Abu
Anzeige
AW: Update funktion
04.11.2009 08:19:23
Chris
Servus,
vom Prinzip her kein Problem. Was ist mit gleichen Einträgen, also wenn in F2 dasselbe steht wie in F8? Ist Dann auch X2,Y2,Z2 gleich, oder sind die in jeder Zeile anders ? Dann wird's schwierig wegen der Zuordnung.
Gruß
Chris
AW: Update funktion
04.11.2009 11:20:04
abu
Hallo Chris,
in Spalte F kann ein Wert nur einmal vorkommen (es ist immer ein 5-stelliger Wert).
Was noch rein muesste: kann Datei Planung auch einmal durchlaufen werden und gecheckt werden ob der Wert in F in der Update Datei gefunden wird? Wenn ja, alles so lassen, wenn der Wert nicht gefunden wird muss die ganze Zeile aus Planung geloescht werden.
Gruss Abu
Anzeige
AW: Update funktion
04.11.2009 14:25:16
Chris
Servus,
probier mal an einer Beispieldatei, ob das so hibhaut, wie das gerne möchtest:
Sub ABU()
Dim Pfad As String, WksZiel As Worksheet, WksQuelle As Worksheet
Dim Fso, DateiName, i
Dim rSuche As Range, rFinde As Range
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WksZiel = ThisWorkbook.ActiveSheet
Pfad = "C:\....\2009\" ' Hier deinen Pfad vorgeben
DateiName = Pfad & "\" & ActiveSheet.Name & ".xls"
Application.ScreenUpdating = False
If Fso.FileExists(DateiName) Then
Workbooks.Open DateiName
Else
MsgBox "nichts da!"
Application.ScreenUpdating = True
Exit Sub
End If
Set WksQuelle = ActiveWorkbook.ActiveSheet 'Suche in Planungsdatei nach den einzelnen  _
Werten aus Spalte F von der geöffneten Datei
With WksZiel
Set rFinde = .Range("F:F")
For i = 2 To WksQuelle.Cells(65536, 6).End(xlUp).Row
Set rSuche = rFinde.Find(what:=WksQuelle.Cells(i, 6), LookAt:=xlWhole, LookIn:= _
xlValues)
If Not rSuche Is Nothing Then ' wenn da , werte ersetzen
.Range("X" & rSuche.Row) = WksQuelle.Range("X" & i)
.Range("Y" & rSuche.Row) = WksQuelle.Range("Y" & i)
.Range("Z" & rSuche.Row) = WksQuelle.Range("Z" & i)
Else
WksQuelle.Rows(i).Copy .Cells(.Cells(65536, 6).End(xlUp).Row, 1) ' sonst zeile  _
kopieren
End If
Next i
End With
With WksZiel
Set rFinde = WksQuelle.Range("F:F") ' Suche in Update in Spalte F, ob alle Einträge  _
aus Planung vorhanden
For i = .Cells(65536, 6).End(xlUp).Row To 2 Step -1
Set rSuche = rFinde.Find(what:=.Cells(i, 6), LookAt:=xlWhole, LookIn:=xlValues)
If rSuche Is Nothing Then ' wenn nicht lösche in Planung die entsprechende Zeile
.Rows(i).EntireRow.Delete
End If
Next i
End With
Set rFinde = Nothing
Set rSuche = Nothing
Application.ScreenUpdating = True
End Sub
ist mangels Beispieldateien natürlich ungetestet, deswegen auch nicht an der Originaldatei zu testen.
Gruß
Chris
Anzeige
AW: Update funktion
06.11.2009 09:27:44
abu
Hallo Chris,
erstmal ein ganz grosses DANKE fuer deine Unterstuetzung! Leider bin ich bis jetzt noch nicht dazu gekommen es zu testen, ich fand es nur unhoeflich nichts zurueck zu schreiben Ich hoffe ich komme Montag dazu aber im Moment hab ich jede menge Stress. Sobald ich es geschafft hab gebe ich feedback.
Also nochmals DANKE.
Gruss abu
Anzeige
AW: Update funktion
09.11.2009 15:40:04
Chris
Servus,
ich hab übrigens einen kleinen Fehler entdeckt:
Sub ABU()
Dim Pfad As String, WksZiel As Worksheet, WksQuelle As Worksheet
Dim Fso, DateiName, i
Dim rSuche As Range, rFinde As Range
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WksZiel = ThisWorkbook.ActiveSheet
Pfad = "C:\....\2009\" ' Hier deinen Pfad vorgeben
DateiName = Pfad & "\" & ActiveSheet.Name & ".xls"
Application.ScreenUpdating = False
If Fso.FileExists(DateiName) Then
Workbooks.Open DateiName
Else
MsgBox "nichts da!"
Application.ScreenUpdating = True
Exit Sub
End If
Set WksQuelle = ActiveWorkbook.ActiveSheet 'Suche in Planungsdatei nach den einzelnen  _
Werten aus Spalte F von der geöffneten Datei
With WksZiel
Set rFinde = .Range("F:F")
For i = 2 To WksQuelle.Cells(65536, 6).End(xlUp).Row
Set rSuche = rFinde.Find(what:=WksQuelle.Cells(i, 6), LookAt:=xlWhole, LookIn:= _
xlValues)
If Not rSuche Is Nothing Then ' wenn da , werte ersetzen
.Range("X" & rSuche.Row) = WksQuelle.Range("X" & i)
.Range("Y" & rSuche.Row) = WksQuelle.Range("Y" & i)
.Range("Z" & rSuche.Row) = WksQuelle.Range("Z" & i)
Else
WksQuelle.Rows(i).Copy .Cells(.Cells(65536, 6).End(xlUp).Row + 1, 1) ' hier hat  _
ein + 1 gefehlt
End If
Next i
End With
With WksZiel
Set rFinde = WksQuelle.Range("F:F") ' Suche in Update in Spalte F, ob alle Einträge   _
_
aus Planung vorhanden
For i = .Cells(65536, 6).End(xlUp).Row To 2 Step -1
Set rSuche = rFinde.Find(what:=.Cells(i, 6), LookAt:=xlWhole, LookIn:=xlValues)
If rSuche Is Nothing Then ' wenn nicht lösche in Planung die entsprechende Zeile
.Rows(i).EntireRow.Delete
End If
Next i
End With
Set rFinde = Nothing
Set rSuche = Nothing
Application.ScreenUpdating = True
End Sub

hier nochmal der Abschnitt der fehlerhaft war:
Else
WksQuelle.Rows(i).Copy .Cells(.Cells(65536, 6).End(xlUp).Row + 1, 1) ' hier hat ein + 1 gefehlt
End If
ohne das +1 kopiert er immer in die letzte beschriebene Zeile. Ich hab das in obigem Makro bereits verbessert.
Gruß
Chris
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige