HERBERS Excel-Forum - das Archiv
Thema: Bildschirmaufbau unterdrücken
Bildschirmaufbau unterdrücken
Peter
Hallo zusammen,
ich bräuchte wieder Eure Hilfe.
Beim Übertragen von Werten springe ich immer zwischen zwei offenen Dateien.
Damit der Bildschirm nicht immer aufgebaut wird habe ich den Befehl:
Application.ScreenUpdating = False (true) verwendet.
Innerhalb einer Datei funktioniert das auch. Beim hin- und her-Springen zwischen zwei offenen Dateien scheint es nicht zu funktionieren.
Gibt es eventuell für die Unterdrückung des "Bildschirm-Aufbaues" noch einen anderen Befehl?
Danke für Eure Hilfe im voraus,
Peter
AW: Bildschirmaufbau unterdrücken
Rudi
Hallo,
Beim Übertragen von Werten springe ich immer zwischen zwei offenen Dateien.
Lass das sein. Dann flackert auch nichts.
Select/ Activate ist meistens unnötig.
Gruß
Rudi
AW: Bildschirmaufbau unterdrücken
Peter
Hallo Rudi,
leider muss ich das tun.
Es geht hier um Mitgliedsadressen die an zwei unterschiedlichen Stellen eingegeben werden.
In meiner Adressen-Datei füge ich aber zusätzlich potentielle Mitglieder ein (die in der normalen Adressenliste nicht sein dürfen).
(Dabei ist meine Mitgliederliste im Gegenteil zu der einfachen Mitgliedereingabemaske- und Liste, die andere Mitarbeiter pflegen, ein Teil eines umfangreichen Systems)
Nach einer gewissen Zeit aktualisiere ich mein Gesamt-System. Dabei ergänze ich meine Adressendatei mit den Adressen der neu eingegebenen Mitglieder und hier greife ich eben auf die andere Datei zu.
Das ist der Hintergrund dazu.
Das Flackern ist leicht nervig, wenn es ab keine simple Lösung dazu gibt, dann flackerts eben.
Liebe Grüße,
Peter
zeig deinen Code. owT
Rudi
AW: zeig deinen Code. owT
Peter
Hallo Rudi,
so sieht er aus.
Sub MitgliederEinlesenNeu()
Dim arr As Variant
Dim iRow As Integer
Dim lz, ls, i, j, lz1, ls1 As Integer
Dim Mitgliedernr, bereitsvorhanden As String
Application.ScreenUpdating = False
'Öffnen der Originaladressen-Datei auf Laufwerk X
Workbooks.Open "X:\XYZ\Mitgliederadressen.xlsm" 'Pfad anpassen!
Worksheets("Mitglieder").Activate
'Letzte Zeile und Spalte in Mitgliederadressen bestimmen
lz = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile bestimmen
ls = Cells(6, Columns.Count).End(xlToLeft).Column 'letzte Spalte bestimmen
For i = 1 To lz - 6
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Mitgliedernr = Cells(6 + i, 2) 'Mitgliederadresse bestimmen
Range(Cells(6 + i, 2), Cells(6 + i, ls)).Select
Selection.Copy
'Zu XYZ springen
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
lz1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile im XYZ bestimmen
ls1 = Cells(10, Columns.Count).End(xlToLeft).Column 'letzte Spalteim XYZ bestimmen
bereitsvorhanden = "nein"
For j = 1 To lz1 - 10
If bereitsvorhanden = "ja" Then
Exit For
Else
'Überprüfen, ob der Kunde in Mitgliederadressen auch in
'STVer XYZ Mitgliederanschriften vorhanden ist
Dim ws As Worksheet, efz%, gef As Range
Set ws = ThisWorkbook.Worksheets("Mitgliederanschrift")
Set gef = ws.Range(Cells(11, 2), Cells(lz1, 2)).Find(Mitgliedernr)
If gef Is Nothing Then
'Wenn die Adresse im XYZ nicht vorhanden ist, dann wird sie ans Ende
'der Tabelle eingefügt
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Range(Cells(6 + i, 2), Cells(6 + i, ls)).Select
Selection.Copy
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
Range(Cells(lz1 + 1, 2), Cells(lz1 + 1, ls)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'Wenn die Adresse im XYZ vorhanden ist, dann wird sie mit der Adresse
'aus Mitgliederadressen überschrieben
If Mitgliedernr = Cells(10 + j, 2) Then
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Range(Cells(6 + i, 2), Cells(6 + i, ls1)).Select
Selection.Copy
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
Range(Cells(10 + j, 2), Cells(10 + j, ls)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bereitsvorhanden = "ja"
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
AW: zeig deinen Code. owT
Rudi
Hallo,
teste mal:
Sub MitgliederEinlesenNeu()
Dim lz As Long, ls As Long, i As Long, j As Long, lz1 As Long, ls1 As Long
Dim MitgliederNr, BereitsVorhanden As Boolean
Dim wksMitgliederAdr As Worksheet, wksMitgliederMetChem As Worksheet
Dim gef As Range
Application.ScreenUpdating = False '1x reicht!
'Öffnen der Originaladressen-Datei auf Laufwerk X
Set wksMitgliederAdr = Workbooks.Open("X:\XYZ\Mitgliederadressen.xlsm").Sheets("Mitglieder") _
'Pfad anpassen!
'Letzte Zeile und Spalte in Mitgliederadressen bestimmen
Set wksMitgliederMetChem = ThisWorkbook.Sheets("Mitgliederanschrift")
With wksMitgliederAdr
lz = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile bestimmen
ls = .Cells(6, Columns.Count).End(xlToLeft).Column 'letzte Spalte bestimmen
End With
For i = 1 To lz - 6
With wksMitgliederAdr
MitgliederNr = .Cells(6 + i, 2) 'Mitgliederadresse bestimmen
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls)).Copy
End With
'Zu XYZ springen
With wksMitgliederMetChem
lz1 = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile im XYZ bestimmen
ls1 = .Cells(10, Columns.Count).End(xlToLeft).Column 'letzte Spalteim XYZ bestimmen
BereitsVorhanden = False
For j = 1 To lz1 - 10
If BereitsVorhanden = True Then
Exit For
Else
'Überprüfen, ob der Kunde in Mitgliederadressen auch in
'STVer XYZ Mitgliederanschriften vorhanden ist
Set gef = .Range(.Cells(11, 2), .Cells(lz1, 2)).Find(MitgliederNr)
If gef Is Nothing Then
'Wenn die Adresse im XYZ nicht vorhanden ist, dann wird sie ans Ende
'der Tabelle eingefügt
With wksMitgliederAdr
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls)).Copy
End With
.Range(.Cells(lz1 + 1, 2), .Cells(lz1 + 1, ls)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
'Wenn die Adresse im XYZ vorhanden ist, dann wird sie mit der Adresse
'aus Mitgliederadressen überschrieben
If MitgliederNr = .Cells(10 + j, 2) Then
With wksMitgliederAdr
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls1)).Copy
End With
.Range(.Cells(10 + j, 2), .Cells(10 + j, ls)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
BereitsVorhanden = True
End If
End If
Next j
End With
Next i
End Sub
Gruß
Rudi
AW: zeig deinen Code. owT
Peter
Hallo Rudi,
vielen Dank.
Ich habe deinen Code eingesetzt. Leider hat es nicht funktioniert.
Damit sollte es gut sein.
Da dein Code viel besser ist als meiner werde ich deinen Code verwenden und meinen löschen.
Vielen Dank für deine, immer sehr geschätzte, Unterstützung.
(Durch deine Hilfe und Vorschläge lerne ich VBA immer mehr, auch diesmal. Vielen Dank!)
Ich wünsche dir ein schönes Wochenende.
Liebe Grüße,
Peter
Bildschirmaufbau unterdrücken
Peter
Hallo zusammen,
ich bräuchte wieder Eure Hilfe.
Beim Übertragen von Werten springe ich immer zwischen zwei offenen Dateien.
Damit der Bildschirm nicht immer aufgebaut wird habe ich den Befehl:
Application.ScreenUpdating = False (true) verwendet.
Innerhalb einer Datei funktioniert das auch. Beim hin- und her-Springen zwischen zwei offenen Dateien scheint es nicht zu funktionieren.
Gibt es eventuell für die Unterdrückung des "Bildschirm-Aufbaues" noch einen anderen Befehl?
Danke für Eure Hilfe im voraus,
Peter
AW: Bildschirmaufbau unterdrücken
Rudi
Hallo,
Beim Übertragen von Werten springe ich immer zwischen zwei offenen Dateien.
Lass das sein. Dann flackert auch nichts.
Select/ Activate ist meistens unnötig.
Gruß
Rudi
AW: Bildschirmaufbau unterdrücken
Peter
Hallo Rudi,
leider muss ich das tun.
Es geht hier um Mitgliedsadressen die an zwei unterschiedlichen Stellen eingegeben werden.
In meiner Adressen-Datei füge ich aber zusätzlich potentielle Mitglieder ein (die in der normalen Adressenliste nicht sein dürfen).
(Dabei ist meine Mitgliederliste im Gegenteil zu der einfachen Mitgliedereingabemaske- und Liste, die andere Mitarbeiter pflegen, ein Teil eines umfangreichen Systems)
Nach einer gewissen Zeit aktualisiere ich mein Gesamt-System. Dabei ergänze ich meine Adressendatei mit den Adressen der neu eingegebenen Mitglieder und hier greife ich eben auf die andere Datei zu.
Das ist der Hintergrund dazu.
Das Flackern ist leicht nervig, wenn es ab keine simple Lösung dazu gibt, dann flackerts eben.
Liebe Grüße,
Peter
zeig deinen Code. owT
Rudi
AW: zeig deinen Code. owT
Peter
Hallo Rudi,
so sieht er aus.
Sub MitgliederEinlesenNeu()
Dim arr As Variant
Dim iRow As Integer
Dim lz, ls, i, j, lz1, ls1 As Integer
Dim Mitgliedernr, bereitsvorhanden As String
Application.ScreenUpdating = False
'Öffnen der Originaladressen-Datei auf Laufwerk X
Workbooks.Open "X:\XYZ\Mitgliederadressen.xlsm" 'Pfad anpassen!
Worksheets("Mitglieder").Activate
'Letzte Zeile und Spalte in Mitgliederadressen bestimmen
lz = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile bestimmen
ls = Cells(6, Columns.Count).End(xlToLeft).Column 'letzte Spalte bestimmen
For i = 1 To lz - 6
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Mitgliedernr = Cells(6 + i, 2) 'Mitgliederadresse bestimmen
Range(Cells(6 + i, 2), Cells(6 + i, ls)).Select
Selection.Copy
'Zu XYZ springen
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
lz1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile im XYZ bestimmen
ls1 = Cells(10, Columns.Count).End(xlToLeft).Column 'letzte Spalteim XYZ bestimmen
bereitsvorhanden = "nein"
For j = 1 To lz1 - 10
If bereitsvorhanden = "ja" Then
Exit For
Else
'Überprüfen, ob der Kunde in Mitgliederadressen auch in
'STVer XYZ Mitgliederanschriften vorhanden ist
Dim ws As Worksheet, efz%, gef As Range
Set ws = ThisWorkbook.Worksheets("Mitgliederanschrift")
Set gef = ws.Range(Cells(11, 2), Cells(lz1, 2)).Find(Mitgliedernr)
If gef Is Nothing Then
'Wenn die Adresse im XYZ nicht vorhanden ist, dann wird sie ans Ende
'der Tabelle eingefügt
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Range(Cells(6 + i, 2), Cells(6 + i, ls)).Select
Selection.Copy
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
Range(Cells(lz1 + 1, 2), Cells(lz1 + 1, ls)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'Wenn die Adresse im XYZ vorhanden ist, dann wird sie mit der Adresse
'aus Mitgliederadressen überschrieben
If Mitgliedernr = Cells(10 + j, 2) Then
Application.ScreenUpdating = False
Windows("Mitgliederadressen.xlsm").Activate
Sheets("Mitglieder").Activate
Range(Cells(6 + i, 2), Cells(6 + i, ls1)).Select
Selection.Copy
Application.ScreenUpdating = False
Windows("Metall_Chemie XYZ.xlsm").Activate
Sheets("Mitgliederanschrift").Activate
Range(Cells(10 + j, 2), Cells(10 + j, ls)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bereitsvorhanden = "ja"
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
AW: zeig deinen Code. owT
Rudi
Hallo,
teste mal:
Sub MitgliederEinlesenNeu()
Dim lz As Long, ls As Long, i As Long, j As Long, lz1 As Long, ls1 As Long
Dim MitgliederNr, BereitsVorhanden As Boolean
Dim wksMitgliederAdr As Worksheet, wksMitgliederMetChem As Worksheet
Dim gef As Range
Application.ScreenUpdating = False '1x reicht!
'Öffnen der Originaladressen-Datei auf Laufwerk X
Set wksMitgliederAdr = Workbooks.Open("X:\XYZ\Mitgliederadressen.xlsm").Sheets("Mitglieder") _
'Pfad anpassen!
'Letzte Zeile und Spalte in Mitgliederadressen bestimmen
Set wksMitgliederMetChem = ThisWorkbook.Sheets("Mitgliederanschrift")
With wksMitgliederAdr
lz = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile bestimmen
ls = .Cells(6, Columns.Count).End(xlToLeft).Column 'letzte Spalte bestimmen
End With
For i = 1 To lz - 6
With wksMitgliederAdr
MitgliederNr = .Cells(6 + i, 2) 'Mitgliederadresse bestimmen
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls)).Copy
End With
'Zu XYZ springen
With wksMitgliederMetChem
lz1 = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile im XYZ bestimmen
ls1 = .Cells(10, Columns.Count).End(xlToLeft).Column 'letzte Spalteim XYZ bestimmen
BereitsVorhanden = False
For j = 1 To lz1 - 10
If BereitsVorhanden = True Then
Exit For
Else
'Überprüfen, ob der Kunde in Mitgliederadressen auch in
'STVer XYZ Mitgliederanschriften vorhanden ist
Set gef = .Range(.Cells(11, 2), .Cells(lz1, 2)).Find(MitgliederNr)
If gef Is Nothing Then
'Wenn die Adresse im XYZ nicht vorhanden ist, dann wird sie ans Ende
'der Tabelle eingefügt
With wksMitgliederAdr
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls)).Copy
End With
.Range(.Cells(lz1 + 1, 2), .Cells(lz1 + 1, ls)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
'Wenn die Adresse im XYZ vorhanden ist, dann wird sie mit der Adresse
'aus Mitgliederadressen überschrieben
If MitgliederNr = .Cells(10 + j, 2) Then
With wksMitgliederAdr
.Range(.Cells(6 + i, 2), .Cells(6 + i, ls1)).Copy
End With
.Range(.Cells(10 + j, 2), .Cells(10 + j, ls)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
BereitsVorhanden = True
End If
End If
Next j
End With
Next i
End Sub
Gruß
Rudi
AW: zeig deinen Code. owT
Peter
Hallo Rudi,
vielen Dank.
Ich habe deinen Code eingesetzt. Leider hat es nicht funktioniert.
Damit sollte es gut sein.
Da dein Code viel besser ist als meiner werde ich deinen Code verwenden und meinen löschen.
Vielen Dank für deine, immer sehr geschätzte, Unterstützung.
(Durch deine Hilfe und Vorschläge lerne ich VBA immer mehr, auch diesmal. Vielen Dank!)
Ich wünsche dir ein schönes Wochenende.
Liebe Grüße,
Peter
Excel-Beispiele