Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Bedingte Formatierung v. Blatt zu Blatt | Herbers Excel-Forum


Betrifft: Bedingte Formatierung v. Blatt zu Blatt von: Matthias
Geschrieben am: 08.01.2012 10:47:20

Guten Tag u. Hallo @ All,

ist es möglich die bedingte Formatierung "meherer Bereiche" von Blatt 1 in Andere Blätter zu übertragen?
(von Blatt1 nach Blatt 2-16) Geht sowas nur per Hand?

Die 6 Bereiche bleiben stets die gleichen.

F13:AJ14 ; F19:AJ20 ; F25:AJ26 ; F33:AJ34 ; F55:AJ56 ; F77:AJ78

Oder muss ich mich nach den Formeln richten,

=ZÄHLENWENN(Feiertage;'1'!F77)>=1
=REST('1'!F77;7)=0
=REST('1'!F77;7)=1

Gruß Matthias

  

Betrifft: Formatierung v. Blatt zu Blatt kopieren ... von: Matthias L
Geschrieben am: 08.01.2012 11:55:46

Hallo Matthias

aktive Tabelle = Tabelle1
Darin sind die bedingt formatierten Zellen

Option Explicit
Sub MeineZellen()
Dim MyAddy$, C As Range
Application.ScreenUpdating = False
For Each C In Cells.SpecialCells(xlCellTypeAllFormatConditions)
   'MsgBox "bedingte Formatierung gefunden in: " & C.Address
    C.Copy
    Tabelle2.Range(C.Address).PasteSpecial Paste:=xlFormats
    Tabelle3.Range(C.Address).PasteSpecial Paste:=xlFormats
    Application.CutCopyMode = False
Next
Application.ScreenUpdating = True
MsgBox "fertig"
End Sub
Tabelle2 & Tabelle3 sind die CodeNamen! der Registerblätter (nicht! die Registerblattnamen)

https://www.herber.de/bbs/user/78296.xls

Gruß Matthias L.


  

Betrifft: Danke Namensvetter :-),.... von: Matthias
Geschrieben am: 08.01.2012 14:17:12

läuft,...ist aber dann durch die vielen Bereich und der 12 Sheets sehr langsam.
1 Frage: Dim MyAddy$ ??? was bewirkt das ?

2 Vermutung:
könnte es durch die feststehen Bereiche nicht schneller gehn,
so denke ich durchsucht er ja erst alles, oder?

Auslesen x= Range F13:AJ14 ; F19:AJ20 ; F25:AJ26 ; F33:AJ34 ; F55:AJ56 ; F77:AJ78
Ziel erledigen in Y=Range F13:AJ14 ; F19:AJ20 ; F25:AJ26 ; F33:AJ34 ; F55:AJ56 ; F77:AJ78

Tabelle1 Vorgabe
Tabelle2-12 Ziele

gez Namensvetter


  

Betrifft: AW: Danke Namensvetter :-),.... von: Reinhard
Geschrieben am: 08.01.2012 16:37:54

Hallo Matthias,

der Anhang $ gibt an daß es eine Stringvariable ist.
Gibt auch Kürzel für Integer usw., steht irgendwo in der Hilfe.
Ich finde die bloß nie auf die Schnelle :-(

Sub MeineZellen()
Dim C As Range, T As Integer
Application.ScreenUpdating = False
With Worksheets("Tabelle1").Range("F13:AJ14,F19:AJ20,F25:AJ26,F33:AJ34,F55:AJ56,F77:AJ78")
  On Error Resume Next
  For Each C In .SpecialCells(xlCellTypeAllFormatConditions)
    On Error GoTo 0
    C.Copy
    ' Schade, mit Array klappt es wohl nicht :-(
    'Sheets(Array("Tabelle2", "Tabelle3")).Range(C.Address).PasteSpecial Paste:=xlFormats
    For T = 2 To ThisWorkbook.Worksheets.Count - 1
      Worksheets(T).Range(C.Address).PasteSpecial Paste:=xlFormats
    Next T
  Next
  Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
MsgBox "fertig"
End Sub

Gruß
Reinhard


  

Betrifft: wirf das "- 1" raus o.w.T. von: Reinhard
Geschrieben am: 08.01.2012 16:39:23




  

Betrifft: Danke -Euch Beiden ..., von: Matthias
Geschrieben am: 08.01.2012 17:35:31

schade,...beide Versionen arbeiten und erfüllen ihren Zweck, aber die zeitliche Abarbeitung bleibt identisch.
die Codes benötigen für die 12 Blätter geschlagene 3Minuten.
Nun ja,...ich spare mir damit viele Eingabearbeit, was will Matze noch mehr.

Viele Danke

Matthias


  

Betrifft: Wieso dauert der Code 3 Minuten? von: Reinhard
Geschrieben am: 08.01.2012 18:12:59

Hallo Matze,

die 3 min erscheinen mir recht lang.

Nimm mal eine neue leere Mappe, NICHT das Original
und rufe dort mal die Prozedur "test" auf.
Bei mir wird ca. 15 sec angezeigt.
Vielleicht habe ich einen Denkfehler im Code, deshalb Frage auf noch offen damit andere klären können
warum du sagst 3 min und ich 15 sec. Habe ich da was falsch "nachgebaut"?

Gruß
Reinhard

Option Explicit

Sub test()
Dim T As Single
Call BlaetterLoeschen
Call BlaetterErzeugen
Call Bed_Format
T = Timer
Call MeineZellen
MsgBox Timer - T
End Sub

Sub MeineZellen()
  Dim C As Range, T As Integer
  Application.ScreenUpdating = False
  With Worksheets("Tabelle1").Range("F13:AJ14,F19:AJ20,F25:AJ26,F33:AJ34,F55:AJ56,F77:AJ78")
    On Error Resume Next
    For Each C In .SpecialCells(xlCellTypeAllFormatConditions)
      On Error GoTo 0
      C.Copy
      ' Schade, mit Array klappt es wohl nicht :-(
      'Sheets(Array("Tabelle2", "Tabelle3")).Range(C.Address).PasteSpecial Paste:=xlFormats
      For T = 2 To ThisWorkbook.Worksheets.Count
        Worksheets(T).Range(C.Address).PasteSpecial Paste:=xlFormats
      Next T
    Next
    Application.CutCopyMode = False
  End With
  Application.ScreenUpdating = True
  'MsgBox "fertig"
  End Sub

Sub Bed_Format()
With Worksheets("Tabelle1").Range("F13:AJ14,F19:AJ20,F25:AJ26,F33:AJ34,F55:AJ56,F77:AJ78")
  .FormatConditions.Delete
  .FormatConditions.Add Type:=xlExpression, Formula1:="=A1>5"
  .FormatConditions(1).Interior.ColorIndex = 27
End With
End Sub

Sub BlaetterErzeugen()
While Worksheets.Count < 16
  Worksheets.Add after:=Worksheets(Worksheets.Count)
Wend
End Sub

Sub BlaetterLoeschen()
Application.DisplayAlerts = False
While Worksheets.Count > 1
  Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
End Sub



  

Betrifft: Schleife nur im Bereich (Union) von: Matthias L
Geschrieben am: 08.01.2012 18:15:18

Hallo Matthias

Excel hat ja auch mit Cells.SpecialCells ... alle Zellen des Blattes geprüft. Ist aber nicht nötig.
Probiers mal so:

Option Explicit
Sub MeineZellen()
Dim MyAddy$, C As Range, Bereich As Range
Application.ScreenUpdating = False 'Bildschirmaktualisierung aus
Application.Calculation = xlManual 'Berechnung auf manuell
Set Bereich = Union(Range("F13:AJ14"), Range("F19:AJ20"), Range("F25:AJ26"), Range("F33:AJ34"),  _
Range("F55:AJ56"), Range("F77:AJ78"))
For Each C In Bereich.SpecialCells(xlCellTypeAllFormatConditions)
    C.Copy
    Tabelle2.Range(C.Address).PasteSpecial Paste:=xlFormats
    Tabelle3.Range(C.Address).PasteSpecial Paste:=xlFormats
    Application.CutCopyMode = False
Next
Application.Calculation = xlAutomatic 'Berechnung auf automatisch
Application.ScreenUpdating = True     'Bildschirmaktualisierung an
MsgBox "fertig"
End Sub

Dauert bei mir keine 3 Sekunden

Gruß Matthias L.


  

Betrifft: Nochmals Danke an Euch Beide !.... von: Matthias
Geschrieben am: 09.01.2012 15:06:09

Thema ist abgearbeitet und es läuft jetzt tatelos, mit beiden Varianten,
habe die Mappen neu aufgesetzt und dann Eure Codes getestet, der Tipp war goldrichtig.
Vermute da war zuviel Caos im Orginal.

Thx u. Gruß
Matthias


  

Betrifft: AW: Nochmals Danke an Euch Beide !.... von: Reinhard
Geschrieben am: 09.01.2012 18:49:29

Hallo Matthias,

danke für die Rückmeldung.
Der Code von Matthias geht ja nur über zwei Blätter, meiner über ca. 15, insofern sind seine 3 sec und meine 15 sec erklärbar.
Aber 3 min ist eine andere Dimension, die m.E. der Code nicht hergibt.
Wenn es jetzt bei dir klappt so im Bereich von 15-30 sec ist doch alles okay.

Gruß
Reinhard


Beiträge aus den Excel-Beispielen zum Thema "Bedingte Formatierung v. Blatt zu Blatt"