..."61"
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
For Each Veri In Range("N6:AR155")
If Veri.DisplayFormat.Interior.ColorIndex = 6 Then
If Cells(Veri.Row, "L") <> "" Then Veri.Value = "B"
End If
Next
ActiveSheet.Protect "61"...
..."61"
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
For Each Veri In Range("N6:AR155")
If Veri.DisplayFormat.Interior.ColorIndex = 6 Then
If Cells(Veri.Row, "L") <> "" Then Veri.Value = "B"
End If
Next
ActiveSheet.Protect "61"...
..."61"
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
For Each Veri In Range("N6:AR155")
If Veri.DisplayFormat.Interior.ColorIndex = 6 Then
If Cells(Veri.Row, "L") <> "" Then Veri.Value = "X"
End If
Next
ActiveSheet.Protect "61"...
...renklenen hücreleri sorgulamak ise aşağıdaki kodu kullanabilirsiniz.
Sub X_Yaz()
Dim Veri As Range
Range("N6:AR155").ClearContents
For Each Veri In Range("N6:AR155")
If Veri.DisplayFormat.Interior.ColorIndex = 6 Then
Veri.Value = "X"
End If
Next...
...As Range) As Long
Dim xcolor As Long
xcolor = Hangi_Rengi_sayacagim.Interior.ColorIndex
For Each datax In bolge
If DisplayFormat.Interior.ColorIndex = xcolor Then
Renkli_Hucreleri_Say = Renkli_Hucreleri_Say + 1
End If
Next datax
End Function...
Koşullu biçimlendirme dolgu renklerini saydırmak için aşağıdaki kalıbı kullanmalısınız.(örn DisplayFormat.Interior.ColorIndex=3 gibi)
DisplayFormat.Interior.ColorIndex
Koray Bey Kod ilk mesajımdaki dosyada düzgün çalışıyor.yeni kopya oluşuyor.formüller makrolar siliniyor.koşullar siliniyor.renkler kalıyor.(y)
Fakat ben başka bir dosyaya bu kodu uyguladığım zaman kod yeni kopyayı oluşturuyor.formül, koşul ,makro, renkleri siliyor ve hücre içeriklerini bozuyor
...Is Nothing Then
For Each Alan In Kosullu_Bicimlendirme
Alan.Interior.ColorIndex = Alan.DisplayFormat.Interior.ColorIndex
Alan.Font.ColorIndex = Alan.DisplayFormat.Font.ColorIndex
Next...
Koşullu biçimlendirmede ofis 2007 ve aşağıdaki sürümlerde DisplayFormat özelliği bulunmadığından ben FormatConditions(1).Interior.ColorIndex özelliği ile kodu yazdım.
aşağıdaki link, irdeleyiniz...
...End With
For Each Alan In Sayfa.Cells.SpecialCells(xlCellTypeAllFormatConditions)
Alan.Interior.ColorIndex = Alan.DisplayFormat.Interior.ColorIndex
Next
Sayfa.Cells.FormatConditions.Delete
Next
Yol = K1.Path & Application.PathSeparator...
...sonuç alamıyorsunuz.
Sonuç almak için ilgili hücredeki koşulu sorgulayabilirsiniz. Ya da KTF yerine normal SUB (Makro) yazmalısınız. Bunda da koşullu biçimlendirme rengini sorgulayan Range("A1").DisplayFormat.Interior.ColorIndex komutunu kullanabilirsiniz. (Uyarı : Bu komut KTF'de çalışmaz)
Bu kodu dener misiniz.
Const MyFile = "C:\TestFolder\Deneme.txt"
Sub ddd()
Open MyFile For Output As #1
For Each deg In Range("b2:b1000")
If deg.DisplayFormat.Interior.ColorIndex = 3 Then
Print #1, deg.Value * 4
End If
Next deg
Close #1
End Sub
Merhaba,
Aşağıdaki kodu dener misiniz.
Const MyFile = "C:\TestFolder\Deneme.txt"
Sub ddd()
For Each deg In Range("b2:b1000")
If deg.DisplayFormat.Interior.ColorIndex = 3 Then tutar = tutar + CLng(deg) * 4
Next deg
Open MyFile For Output As #1
Print #1, Trim(tutar)
Close #1...
...yapılmış çalışma buldum.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim aaa As DisplayFormat
Set aaa = Range("XFD1048576").DisplayFormat
Range("A1:XFD500").Borders.Color = aaa.Borders.Color...
...As Long
Dim indCurCell As Long
cntRes = 0
sumRes = 0
cntCells = Selection.CountLarge
indRefColor = ActiveCell.DisplayFormat.Interior.Color
For indCurCell = 1 To (cntCells - 1)
If indRefColor = Selection(indCurCell).DisplayFormat.Interior.Color Then...
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.