Anzeige
Archiv - Navigation
780to784
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
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kopie einer Tabelle: Werte und Formate übernehmen

Kopie einer Tabelle: Werte und Formate übernehmen
16.07.2006 11:13:57
Fritz
Hallo Forumsbesucher,
ich habe gerade folgendes vergeblich versucht:
Eine komplette Tabelle zu kopieren und danach die Formeln als Werte einzufügen und gleichzeitig alle Formatierungen (auch Formate, die über eine bedingte Formatierung in der Tabelle sind) beizubehalten. Mit Einfügen Inhalte einfügen habe ich es versucht, aber die bedingten Formatierungen werden als Formeln beibehalten.
Gibt es hierfür eine Lösung?
Vorab vielen Dank für jede Form von Hilfe!

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 11:32:01
Josef
Hallo Fritz!
Das ist nicht ganz leicht, aber vieleicht als Ansatz.
Sub test()
Dim rng As Range
Dim i As Integer

On Error Resume Next
Application.ScreenUpdating = False

For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions)
  With rng
    .Select
    For i = 1 To .FormatConditions.Count
      If Evaluate(.FormatConditions(i).Formula1) Then
        .Interior.ColorIndex = .FormatConditions(i).Interior.ColorIndex
        .Font.ColorIndex = .FormatConditions(i).Font.ColorIndex
        .Font.Bold = .FormatConditions(i).Font.Bold
        .Font.Italic = .FormatConditions(i).Font.Italic
        .Font.Underline = .FormatConditions(i).Font.Underline
        .FormatConditions.Delete
        Exit For
      End If
    Next
  End With
Next

Application.ScreenUpdating = True
End Sub


Gruß Sepp

Anzeige
und gleich ein Fehler;-)
16.07.2006 11:36:19
Josef
Sub test()
Dim rng As Range
Dim i As Integer

On Error Resume Next
Application.ScreenUpdating = False

For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions)
  With rng
    .Select
    For i = 1 To .FormatConditions.Count
      If Evaluate(.FormatConditions(i).Formula1) Then
        .Interior.ColorIndex = .FormatConditions(i).Interior.ColorIndex
        .Font.ColorIndex = .FormatConditions(i).Font.ColorIndex
        .Font.Bold = .FormatConditions(i).Font.Bold
        .Font.Italic = .FormatConditions(i).Font.Italic
        .Font.Underline = .FormatConditions(i).Font.Underline
        .FormatConditions.Delete
        Exit For
      End If
    Next
    .FormatConditions.Delete
  End With
Next

Application.ScreenUpdating = True
End Sub


Gruß Sepp

Anzeige
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 11:51:25
Fritz
Hallo Sepp,
freue mich über deine Unterstützung.
Ich habe eben den Code getestet. In der Kopie erscheinen "alle bedingten Formatierungen", ich wollte aber, dass nur die (bedingten) Formatierungen erscheinen, die zum Zeitpunkt der Kopie auch "aktiv" sind. Dein Makro setzt aber alle bedingten Formatierungen aktiv. Die Kopie sollte jedoch dem Original hinsichtlich der Formate zum Zeitpunkt des Kopierens entsprechen.
Gruß
Fritz
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 12:03:39
Josef
Hallo Fritz!
Deshalb schrieb ich ja "ist nicht ganz leicht"!
Das hängt von den verwendeten Formeln ab, die Formeln sollten absolut Adressiert sein, usw.
Schau auch mal hier: http://www.cpearson.com/excel/CFColors.htm
Gruß Sepp
Anzeige
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 12:16:49
Fritz
Hallo Sepp,
ich habe deinen Hinweis gleich richtig gedeutet. Wenn Du schreibst, nicht ganz leicht, dann weiß ich Bescheid. Ich habe mir mal Bedingungen einzelner Zellen ausschließlich absolut formatiert, aber nicht alle in der Tabelle. Auswirkungen des Makros gegenüber meinem vorherigen Versuch waren nicht erkennbar. Muß man alle Zellen mit bedingter Formatierung umstellen, um eine andere (gewünschte) Wirkung zu erreichen?
Wenn es keinen Sinn macht, weitere Versuche anzustellen, schreib mir das.
Wäre auch kein Problem! Kann mir auch nicht vorstellen, dass mir dann hier jemand weiterhelfen kann.
Nochmals vielen Dank für Deine Arbeit
Gruß
Fritz
Anzeige
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 19:00:40
Josef
Hallo Fritz!
Das es keinen Sinn macht kann ich nicht sagen, nur ob es den Aufwand lohnt.
Zeig einmal einige Beispielformeln die du in der Bedingten Formatierung verwendest.
Gruß Sepp

AW: Wozu Beispielformeln? o.T.
16.07.2006 19:10:28
Bugs
AW: Wozu Beispielformeln? o.T.
16.07.2006 19:37:01
Josef
Hallo Bugs!
Wozu Beispielformeln. Weil, wie du sicher weist, das Auslesen der bedingten Formatierung
so ziehmlich das letzte ist, was man sich in VBA antun will.
Und wenn die Formeln z.B. Bezüge auf andere Tabellen enthalten, dann kann man das
IMHO gleich vergessen, weil der Aufwand in keiner Relation zum Ergebnis steht.
Gruß Sepp

Anzeige
AW: Wozu Beispielformeln? o.T.
16.07.2006 19:39:42
Bugs
Hallo Sepp,
nimms mir net böse, sollte nur ein scherz sein da du mich ja auch gefragt hast "Wozu Muster".
Schönen Sonntag wünscht Dir Bugs
AW: Wozu Beispielformeln? o.T.
16.07.2006 20:26:17
Fritz
Hallo Sepp,
habe gerade die letzten Beiträge gelesen.
Nur soviel: Ich melde mich mit "Beispielen" noch.
Aber: Dein Aufwand muss sich "in Grenzen halten", das ist Bedingung.
Ich hab immer neue Vorstellungen, was sich mit EXCEL möglicherweise bewerkstelligen lässt und bin dann immer froh, wenn ich hier so kompetente Hilfe in Anspruch nehmen darf.
Hin und wieder kann ich eben nicht ermessen, wieviel Aufwand die Umsetzung solcher Vorstellungen auch für euch Experten macht und deshalb wie oben bereits gesagt ...
Gruß
Fritz
Anzeige
@Josef Ehrensberger
17.07.2006 19:35:18
Fritz
Hallo Sepp,
hier die gewünschten Informationen.
Die betreffende Tabelle enthält grds. vier "unterschiedliche Arten" von Formeln, von denen ich jeweils hier eine "exemplarisch" aufführe.
1. =ODER(ISTLEER($I$8);ISTLEER($I$9))
2. =UND($G$42=127;$R$14="";$M16$AJ$5)
3. =UND($G$42=127;$R$14="";$M16$AJ$5)
=UND($G$41=31;ISTLEER(AA16))
=ISTZAHL($AA16)
4. =WENN(UND(ISTTEXT(H16);H16=V24);Daten!$I$3;0)
Ich vermute mal, dass genau diese Tatsache (derart unterschiedliche Arten von Formeln) die Realisierung meines meines Vorhabens erschwert und eben einen nicht vertretbaren Arbeitsaufwand zur Folge hat:
Einige Formeln sind absolut adressiert, andere enthalten z.T. eine relative Adressierung bzw. auch "gemischte Adressierungen".
Dann sind Formeln enthalten, die auf ein anderes Tabellenblatt Bezug nehmen (Nr. 4)
Ich vermute, dass die Tatsache, dass einzelne Zellen mehrere Formeln zur bedingten Formatierung enthalten, das Ganze zusätzlich problematisch gestaltet (Nr. 3).
Ebenso sind Formeln enthalten, die einen Bezug auf eine andere Tabelle ("Daten") enthalten (Nr. 4).
Wenn das die Sache "entscheidend" vereinfacht, wäre es für mich kein Problem,
- alle betroffenen Zellen auf Formeln mit aboluter Formatierung "umzustellen"
- den Bezug auf ein anderes Tabellenblatt aus den Formeln zu entfernen
Ich hoffe, die Informationen sind ausreichend genug! Wie gesagt, keinen nicht vertretbaren Arbeitsaufwand.
Die Tabelle hat die Aufgabe, für mehrere Mitglieder eine Auswertung eines Eingungstests vorzunehmen, wobei die bedingten Formatierungen v.a. dazu dienen, fehlerhafte Antworten entsprechend zu kennzeichnen.
Gruß
Fritz
Anzeige
AW: @Josef Ehrensberger
17.07.2006 22:01:46
Josef
Hallo Fritz!
Also. Erstens funktioniert es nur bei Formeln mit absoluten Bezügen!
Formeln mit Bezügen zu anderen Tabellen kann ich nicht testen, weil xl2000 das nicht unterstützt.
Deine Testformeln werden bei mir tadellos ausgelesen und die Formatierung übernommen (nur Hintergrund- und Schriftfarbe).
Mehr will ich dazu nicht mehr beitragen;-)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub test()
Dim rng As Range

On Error Resume Next

For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions)
  With rng
    .Interior.ColorIndex = ColorIndexOfCF(rng)
    .Font.ColorIndex = ColorIndexOfCF(rng, True)
    .FormatConditions.Delete
  End With
Next

On Error GoTo 0

End Sub




'Created By Chip Pearson and Pearson Software Consulting Services
'© Copyright 1997-2000 Charles H. Pearson
'adapted by j.ehrensberger 17/4/06
Function ActiveCondition(rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant
Dim rng1 As Range, rng2 As Range

Set rng1 = Range("IV65535")
Set rng2 = Range("IV65536")

If rng.FormatConditions.Count = 0 Then
  ActiveCondition = 0
Else
  For Ndx = 1 To rng.FormatConditions.Count
    Set FC = rng.FormatConditions(Ndx)
    
    On Error Resume Next
    rng1.FormulaLocal = FC.Formula1
    rng2.FormulaLocal = FC.Formula2
    On Error GoTo 0
    
    Select Case FC.Type
      Case xlCellValue
        Select Case FC.Operator
          Case xlBetween
            Temp = GetStrippedValue(rng1.Formula)
            Temp2 = GetStrippedValue(rng2.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) >= CDbl(rng1.Formula) And _
                CDbl(rng.Value) <= CDbl(rng2.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If rng.Value >= Temp And _
                rng.Value <= Temp2 Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
          Case xlGreater
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) > CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If rng.Value > Temp Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
          Case xlEqual
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) = CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If Temp = rng.Value Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
            
          Case xlGreaterEqual
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) >= CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If rng.Value >= Temp Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
            
          Case xlLess
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) < CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If rng.Value < Temp Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
          Case xlLessEqual
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) <= CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If rng.Value <= Temp Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
            
          Case xlNotEqual
            Temp = GetStrippedValue(rng1.Formula)
            If IsNumeric(Temp) Then
              If CDbl(rng.Value) <> CDbl(rng1.Formula) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If Temp <> rng.Value Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
          Case xlNotBetween
            Temp = GetStrippedValue(rng1.Formula)
            Temp2 = GetStrippedValue(rng2.Formula)
            If IsNumeric(Temp) Then
              If Not (CDbl(rng.Value) <= CDbl(rng1.Formula)) And _
                (CDbl(rng.Value) >= CDbl(rng2.Formula)) Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            Else
              If Not rng.Value <= Temp And _
                rng.Value >= Temp2 Then
                ActiveCondition = Ndx
                GoTo TheExit
              End If
            End If
            
          Case Else
            Debug.Print "UNKNOWN OPERATOR"
        End Select
        
        
      Case xlExpression
        If Application.Evaluate(rng1.Formula) Then
          ActiveCondition = Ndx
          GoTo TheExit
        End If
        
      Case Else
        Debug.Print "UNKNOWN TYPE"
    End Select
    
  Next Ndx
  
End If

ActiveCondition = 0

TheExit:
rng1.Clear
rng2.Clear
Set rng1 = Nothing
Set rng2 = Nothing
End Function


Function ColorIndexOfCF(rng As Range, _
  Optional OfText As Boolean = False) As Integer


Dim AC As Integer
On Error Resume Next
AC = ActiveCondition(rng)
If AC = 0 Then
  If OfText = True Then
    ColorIndexOfCF = rng.Font.ColorIndex
  Else
    ColorIndexOfCF = rng.Interior.ColorIndex
  End If
Else
  If OfText = True Then
    ColorIndexOfCF = rng.FormatConditions(AC).Font.ColorIndex
  Else
    ColorIndexOfCF = rng.FormatConditions(AC).Interior.ColorIndex
  End If
End If

End Function


Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
  Temp = Mid(CF, 3, Len(CF) - 3)
  If Left(Temp, 1) = "=" Then
    Temp = Mid(Temp, 2)
  End If
Else
  Temp = CF
End If
GetStrippedValue = Temp
End Function


Gruß Sepp

Anzeige
AW: @Josef Ehrensberger - Tadellos!
18.07.2006 18:47:27
Fritz
Hallo Sepp,
wie von Dir beschrieben: Bei absoluter Formatierung funktioniert das Ganze einwandfrei!
Deine Arbeit war also keinesfalls umsonst, das freut mich ganz besonders!
Du bist ein Segen für VBA-Laien wie ich es bin!
Ganz herzlichen Dank!
Gruß
Fritz
AW: Kopie einer Tabelle: Werte und Formate überneh
16.07.2006 19:50:25
Fritz
Hallo Sepp,
wollte nur kurz Nachricht geben.
Habe gerade Besuch bekommen und melde mich später ausführlicher.
Danke auch für die Hilfe im anderen Thread. Aber wie weiß, funktioniert das wie gewünscht.
Bis dann
Gruß
Fritz
AW: Kopie einer Tabelle: Werte und Formate übernehmen
16.07.2006 11:32:37
Bugs
Hallo,
hast Du ach Inhalte einfügen - Werte gewählt?
Die bedingte formatierung wird, egal wie eingefügt, immer wie vorhanden eingefügt.
Vielleicht hast Du ja mal eine kleine Datei als Muster, zum probieren.

Rückmeldung wäre nett !!! 


>>> mfg Bugs <<<

Sicher ist, dass nichts sicher ist. Selbst das nicht.

Anzeige
wozu Muster?
16.07.2006 11:37:59
Josef
Hallo Bugs!
Wozu brauchst du dafür ein Muster?
Nichts gegen Beispielmappen, aber hier erkene ich bei bestem Willen keinen Grund.
Gruß Sepp

AW: VBA
16.07.2006 11:43:49
Bugs
Hallo Sepp,
weil es auch ohne VBA gehen sollte, und wenn ich selber sehe wie alles aufgebaut ist, tue ich mich leichter.
Aber wenn Dein Vorschlag funktioniert, ist es natürlich auch OK.
Gruss Bugs
AW: VBA
16.07.2006 12:01:39
Fritz
Hallo Helfer,
war so vertieft mit dem Testen von Sepps Code, dass ich gar nicht mitbekommen habe, was sich im Thread inzwischen getan hat.
Zur Beispieldatei: Ich hoffe, dass es ohne geht, da die Datei für einen Upload zu groß ist. Wenn nicht, müsste ich ein adäquates Beispiel erstellen.
Sepp, dein zweiter Code übernimmt ebenfalls alle bedingten Formatierungen in die Kopie und nicht "nur" die zum Zeitpunkt der Kopie aktiven.
Allen Helfern vielen Dank die Unterstützung!
Gruß
Fritz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige