hücredeki metne göre hücre biçimlendirme

[İhsan Tank]

hücredeki metne göre hücre biçimlendirme

D1 hücresinde yazan metne göre A Sütununa yazdığım Rakamların sonuna
metin ekleme

D1 Hücresinde D Yazıyorsa dm2 Yazsın
Başka Bir şey Yazıyorsa Adet Yazsın

 

[N.Ziya Hiçdurmaz]

yanıt

Sub test()
Dim sat As Integer
    For sat = 3 To Cells(65536, "a").End(xlUp).Row
    Cells(sat, "a") = Split(Cells(sat, "a"), " ")(0)
        If [D1] = "D" Or [D1] = "d" Then
            Cells(sat, "a") = Cells(sat, "a") & " dm 2"
            Else
            Cells(sat, "a") = Cells(sat, "a") & " Adet"
        End If
    Next
End Sub

 

[İhsan Tank]

Sub test()
Dim sat As Integer
    For sat = 3 To Cells(65536, "a").End(xlUp).Row
    Cells(sat, "a") = Split(Cells(sat, "a"), " ")(0)
        If [D1] = "D" Or [D1] = "d" Then
            Cells(sat, "a") = Cells(sat, "a") & " dm 2"
            Else
            Cells(sat, "a") = Cells(sat, "a") & " Adet"
        End If
    Next
End Sub

hocam çok teşekkür ederim.
sanırım soruyu eksik sormuşum.
hücreye ben rakamı girdiğim anda aktif olsa olur mu_?
nasıl düzenliyebilirim kodu ona göre

 

[İhsan Tank]

hocam bir de boş hücre gördüğünde de onu boş bırakması gerek

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) = "d" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " dm 2"
End If
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) <> "d" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " Adet"
End If
git:
End Sub

 

[halit3]

alternatif olarak aşağıdaki kodu denermisiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
a = ActiveWindow.Selection.Row - 1
b = ActiveWindow.Selection.Column
If Val(a) > 0 Then
deg = ""
deg1 = Val(Worksheets(ActiveSheet.Name).Cells(a, b).Value)
If Val(deg1) > 0 Then
If Worksheets(ActiveSheet.Name).Cells(1, 4).Value = "D" Then
deg = "dm2"
ElseIf IsNumeric(Worksheets(ActiveSheet.Name).Cells(1, 4).Value) = True Then
If Worksheets(ActiveSheet.Name).Cells(1, 4).Value > 0 Then
deg = "adet"
End If
ElseIf Worksheets(ActiveSheet.Name).Cells(1, 4).Value = "K" Then
deg = "Kg"
End If
Worksheets(ActiveSheet.Name).Cells(a, b).Value = deg1 & " " & deg
End If
End If
End Sub

 

[İhsan Tank]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) = "d" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " dm 2"
End If
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) <> "d" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " Adet"
End If
git:
End Sub

alternatif olarak aşağıdaki kodu denermisiniz.

hocalarım çok teşekkür ederim.
bir sıkıntı ben buna ikinci bir özellik daha eklemek istesem nere nasıl bir kod eklemeliyim

 

[İhsan Tank]

hocalarım çok teşekkür ederim.
bir sıkıntı ben buna ikinci bir özellik daha eklemek istesem nere nasıl bir kod eklemeliyim

hocamlarım ben sorunumu çözdüm

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) = "N.Ziya" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " dm 2"
End If
If Cells(1, 4) = "Halit" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " dm 2"
End If
If Right(Cells(Target.Row - 1, 1), 4) = "dm 2" Or _
Right(Cells(Target.Row - 1, 1), 4) = "Adet" Then GoTo git
If Cells(1, 4) <> "D" And Cells(Target.Row - 1, 1) <> "" Then
Cells(Target.Row - 1, 1) = Cells(Target.Row - 1, 1) & " Adet"
End If
git:
End Sub

bu kod ile