Bildschirmaufbau unterdrücken

Bild

Betrifft: Bildschirmaufbau unterdrücken
von: Peter Weber
Geschrieben am: 14.08.2015 09:05:26

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

Bild

Betrifft: AW: Bildschirmaufbau unterdrücken
von: Rudi Maintaire
Geschrieben am: 14.08.2015 09:36:44
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

Bild

Betrifft: AW: Bildschirmaufbau unterdrücken
von: Peter Weber
Geschrieben am: 14.08.2015 10:07:16
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

Bild

Betrifft: zeig deinen Code. owT
von: Rudi Maintaire
Geschrieben am: 14.08.2015 10:09:29


Bild

Betrifft: AW: zeig deinen Code. owT
von: Peter Weber
Geschrieben am: 14.08.2015 10:38:24
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


Bild

Betrifft: AW: zeig deinen Code. owT
von: Rudi Maintaire
Geschrieben am: 14.08.2015 11:29:11
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

Bild

Betrifft: AW: zeig deinen Code. owT
von: Peter Weber
Geschrieben am: 14.08.2015 15:32:19
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bildschirmaufbau unterdrücken"