Koşullu Biçimlendirme

[bedri41]

Koşullu biçimlendirme kullanılarak biçimlendirilmiş hücreye yazılan bir metin veya rakamın mesela ilk 3 hanesi veya son 5 hanesi silinebilir mi ?
Örneğin : Al(Kırmızı) = Al( silinecek sadece Kırmızı kalacak veya,
Al(Kırmızı)Elma = Al, Elma ve parantez işaretleri silinip Sadece Kırmızı kalacak.

 

[Korhan Ayhan]

Selamlar,

Kriter belirli ise bir yan hücreye formülle yada makro kullanılarak silme işlemi yapılabilir. Net cevap verebilmemiz için örnek dosya eklermisiniz.

 

[bedri41]

ilişikte örnek bir dosya gönderiyorum. Dosya içine gerekli açıklamayı yazdım.

 

[Korhan Ayhan]

Selamlar,

Aktarım işlemi yapan butona ait kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub CommandButton1_Click()
Dim k As Range, sat As Long, i As Byte, adr As String
Dim sut As Integer, j As Integer
Sheets("OZET").Select
sat = 14
Application.ScreenUpdating = False
Range("A14:F65536").ClearContents
With Sheets("ILLER")
    For i = 1 To 3
        If Controls("TextBox" & i).Value <> "" Then
            Set k = .Range("A:A").Find(Controls("TextBox" & i).Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                adr = k.Address
                Do
                    Cells(sat, "A").Value = k.Value
                    Cells(sat, "B").Value = k.Offset(0, 1).Value
                    Cells(sat, "C").Value = k.Offset(0, 3).Value
                    Cells(sat, "D").Value = k.Offset(0, 5).Value
                    sut = .Cells(k.Row - 1, 256).End(xlToLeft).Column
                    For j = 7 To sut
                        If Left(Trim(.Cells(k.Row - 1, j).Value), 3) = TextBox4.Text Then
                            Cells(sat, "E").NumberFormat = "@"
                            If Cells(sat, "E").Value = "" Then Cells(sat, "E").Value = .Cells(k.Row, j).Value
                            Bul = InStr(1, Cells(sat, "E").Value, "(")
                            If Bul > 0 Then
                            Cells(sat, "E").Value = Mid(Cells(sat, "E").Value, Bul + 1, 4)
                            If Right(Cells(sat, "E").Value, 1) = "-" Or Right(Cells(sat, "E").Value, 1) = "." Then
                            Cells(sat, "E").Value = Mid(Cells(sat, "E").Value, 1, 3)
                            End If
                            End If
                        End If
                        If Left(Trim(.Cells(k.Row - 1, j).Value), 3) = TextBox5.Text Then
                            Cells(sat, "F").NumberFormat = "@"
                            If Cells(sat, "F").Value = "" Then Cells(sat, "F").Value = .Cells(k.Row, j).Value
                            Bul = InStr(1, Cells(sat, "F").Value, "(")
                            If Bul > 0 Then
                            Cells(sat, "F").Value = Mid(Cells(sat, "F").Value, Bul + 1, 4)
                            If Right(Cells(sat, "F").Value, 1) = "-" Or Right(Cells(sat, "F").Value, 1) = "." Then
                            Cells(sat, "F").Value = Mid(Cells(sat, "F").Value, 1, 3)
                            End If
                            End If
                        End If
                    Next j
                    sat = sat + 1
                    Set k = .Range("A:A").FindNext(k)
                Loop While Not k Is Nothing And k.Address <> adr
                Set k = Nothing
            End If
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[bedri41]

Çok teşekkür ederim. Çok güzel olmuş, ellerinize sağlık