Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
inna_90
 | Femeie
23 ani
Vrancea
cauta Barbat
30 - 48 ani |
|
|
TRaP
Moderator
Inregistrat: acum 8 ani
Postari: 951
|
|
The macro below merges the conditional formatting of 2 cells into a third cell.
Sub MergeConditionalFormatting()
Dim src1 As Range, src2 As Range, dest As Range
Dim FC As FormatCondition
Dim i As Long
' Define your source and target cells
On Error Resume Next
' Select Source 1
Set src1 = Application.InputBox("Select the FIRST source cell (e.g., D4):", "Select Source 1", Type:=8)
If src1 Is Nothing Then Exit Sub ' User clicked Cancel
Set src1 = src1.Cells(1, 1) ' Enforce single top-left cell
' Select Source 2
Set src2 = Application.InputBox("Select the SECOND source cell (e.g., M2):", "Select Source 2", Type:=8)
If src2 Is Nothing Then Exit Sub ' User clicked Cancel
Set src2 = src2.Cells(1, 1) ' Enforce single top-left cell
' Select Destination
Set dest = Application.InputBox("Select the DESTINATION cell or range (e.g., K2):", "Select Destination", Type:=8)
If dest Is Nothing Then Exit Sub ' User clicked Cancel
On Error GoTo 0
Application.ScreenUpdating = False
' Step 1: Copy all CF rules from D4 directly to K2
src1.Copy
dest.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
' Step 2: Loop through M2's rules and recreate them on K2
For i = 1 To src2.FormatConditions.count
Set FC = src2.FormatConditions(i)
' Re-create the rule on K2 based on type
On Error Resume Next
Select Case FC.Type
Case xlCellValue
dest.FormatConditions.Add Type:=xlCellValue, Operator:=FC.Operator, _
Formula1:=FC.Formula1, Formula2:=FC.Formula2
Case xlExpression
dest.FormatConditions.Add Type:=xlExpression, Formula1:=FC.Formula1
End Select
' Copy font and fill formatting from src2 rule to the new dest rule
With dest.FormatConditions(dest.FormatConditions.count)
.Interior.Color = FC.Interior.Color
.Font.Color = FC.Font.Color
.Font.Bold = FC.Font.Bold
.Font.Italic = FC.Font.Italic
.StopIfTrue = False
End With
On Error GoTo 0
Next i
Application.ScreenUpdating = True
MsgBox "Successfully merged rules! Target cell now has " & dest.FormatConditions.count & " rules.", vbInformation
End Sub |
Source: Gemini
|
|
| pus acum 3 zile |
|