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

2 Spalten aus 2 Excelmappen vergleichen - anpassen

2 Spalten aus 2 Excelmappen vergleichen - anpassen
14.05.2018 22:20:58
Markus
Liebes Forum,
ich habe folgendes Anliegen an euch:
Ich habe 2 Excelmappen mit den Namen (Master und Aktuell).
In beiden Mappen sind für mich folgende Spalten wichtig:
- Projekt-ID: Master Spalte A (1) - Aktuell A (1)
- Projektstatus: Master R (18) - Aktuell L (12)
- Datum der Statusänderung: Master S (19) - Aktuell M (13)
Ziel: In der Masterdatei befindet sich ein Button, sobald ich diesen drücke, sollen passend zur jeweiligen Projekt-ID, der Status und das Datum der Statusänderung aus der Mappe (Aktuell )kommend, angepasst werden. Sprich, nur wenn eine Änderung vorgenommen wurde. Auch darf kein Status bzw. das Datum der Statusänderung überschrieben werden, falls die Projekt-ID nicht in beiden Tabellen vorhanden ist.
Hier nun mein Makro. Es funktioniert, ABER leider benötigt es sehr lange für diesen Vorgang. Die Tabelle hat ungefähr 400 Zeilen.
Option Explicit
Sub Transfer_Fortschritt()
Dim strPath     As String
Dim Aktuell     As String
Dim MasterSh    As Workbook
Dim findAk      As Range
Dim FS          As Range
Dim maxCount    As Long
Dim AkCount     As Long
strPath = ActiveWorkbook.Path
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
Do
Aktuell = Dir(strPath & "\*.xlsx")
Loop Until Aktuell  ActiveWorkbook.Name
If Aktuell = "" Then Exit Sub
Set MasterSh = ActiveWorkbook
maxCount = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open Filename:=strPath & Aktuell
AkCount = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For Each FS In ActiveWorkbook.Worksheets(1).Range("A4:A" & AkCount)
Set findAk = MasterSh.Worksheets("Master").Columns(1).Find(FS.Value)
If Not findAk Is Nothing Then
findAk.Offset(0, 17).Value = FS.Offset(0, 11).Value
findAk.Offset(0, 18).Value = FS.Offset(0, 12).Value
Else
maxCount = maxCount + 1
MsgBox FS.Offset(0, 0).Value & "        " & FS.Offset(0, 11).Value
MasterSh.Worksheets("Master").Cells(maxCount, 1).Value = FS.Offset(0, 0).Value
MasterSh.Worksheets("Master").Cells(maxCount, 18).Value = FS.Offset(0, 11).Value
MasterSh.Worksheets("Master").Cells(maxCount, 19).Value = FS.Offset(0, 12).Value
End If
Next
Workbooks(Aktuell).Close SaveChanges:=False
End Sub

Meine Bitte an euch Experten: Kann man dieses Makro irgendwie modifizieren bzw. anders schreiben., damit der Vorgang schneller abläuft?
Vielen Dank euch!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 Spalten aus 2 Excelmappen vergleichen - anpassen
15.05.2018 07:55:16
MCO
Moin!
Du könntest die Berechnung und die Bildschirmaktualisierung mal ausschalten.
Wenn andere Events noch angesprochen werden bremst das natürlich auch.
Trage am Anfang ein
Application.screenupdating = false
Application.calculation = xlManual
Application.enableevents = false
Trage am Ende ein
Application.calculation = xlautomatic
Application.enableevents = true
Gruß, MCO
AW: 2 Spalten aus 2 Excelmappen vergleichen - anpassen
16.05.2018 21:47:44
Markus
Hallo MCO,
bin erst heute zum Testen gekommen.
Funktioniert überragend. Vorher ca. 5 Minuten nun knapp 3 Sekunden :)
Mit etwas Verspätung besten Dank dir für deine Hilfe.
Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige