Makro ile hücredeki rakamı koşula bağlı (-) ye çevirme

[necip54]

Merhaba,
Makroda ileri olmadığım için aşağıdaki işi görecek bir makro arıyorum
b3:b1000 arasında seçilen satırdaki aktif b hücresine "ALİ";"VELİ";MEHMET;"CUMHUR";MUSTAFA" yazıldığında V3:v1000 arasındaki o satırdaki V hücresindeki oluşan rakam (-) eksi işaretli olsun.
Şimdiden teşekkürler

 

[Emir Hüseyin Çoban]

. . .

İsim seçenekleri 5 tane mi, yoksa artar mı veya
herhangi bir isim girilirse şeklinde mi yapalım...

. . .

 

[necip54]

. . .

İsim seçenekleri 5 tane mi, yoksa artar mı veya
herhangi bir isim girilirse şeklinde mi yapalım...

. . .

ilerideki duruma göre 5-10 arası artabilir
herhangi bir isim girilirse şeklinde olursa, başka isimleri de bozar, çünkü başka isimlerde işlem normal + kalmalı

 

[Emir Hüseyin Çoban]

. . .

Çalışma sayfasının kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [B3:B1000]) Is Nothing Then Exit Sub
    isimler = Array("", "ALİ", "VELİ", "MEHMET", "CUMHUR", "MUSTAFA") [COLOR="DarkGreen"]' isimleri büyük harfle girin[/COLOR]
    For i = 1 To UBound(isimler)
        If UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ")) = isimler(i) Then
        If Cells(Target.Row, "V") > 0 Then Cells(Target.Row, "V") = Cells(Target.Row, "V") * -1
    End If
Next i

End Sub

. . .

 

[necip54]

Excel dosya adı "KASIM2015" ve bunun içinde 7-8 adet sayfalar var, bu makro bu sayfalardan "Kasım2015" isimli olan çalışma sayfasında çalışacak

bu sayfada başka bir hücredeki başka bir şarta bağlı başka bir hücreyi negatif yapan bir makro vardı, aşağıdaki gibi.
*********
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F3:F1000", "R3:S1000")) Is Nothing Then Exit Sub
On Error GoTo Son
Application.EnableEvents = False

If Cells(Target.Row, "F") = "İPTAL" Then
Cells(Target.Row, "R") = IIf(Cells(Target.Row, "R") > 0, Cells(Target.Row, "R") * -1, Cells(Target.Row, "R"))
Cells(Target.Row, "S") = IIf(Cells(Target.Row, "S") > 0, Cells(Target.Row, "S") * -1, Cells(Target.Row, "S"))
End If

Son: Application.EnableEvents = True
End Sub
********

Yeni şartımızıda bugün sizden istemiştim

 

[Emir Hüseyin Çoban]

. . .

Alt sekmedeki
KASIM2015 sayfa isminin üzerinder sağ tıkla > Kodları Görüntüle >
Açılan ekrana kodları yapıştırın.
B sütununa veri girerecek sonucu inceleyiniz.

. . .

 

[Emir Hüseyin Çoban]

. . .

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [B3:B1000]) Is Nothing Then GoTo atla
    isimler = Array("", "ALİ", "VELİ", "MEHMET", "CUMHUR", "MUSTAFA") ' isimleri büyük harfle girin
    For i = 1 To UBound(isimler)
        If UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ")) = isimler(i) Then
            If Cells(Target.Row, "V") > 0 Then Cells(Target.Row, "V") = Cells(Target.Row, "V") * -1
        End If
    Next i
atla:
    
    If Intersect(Target, Range("F3:F1000", "R3:S1000")) Is Nothing Then Exit Sub
    On Error GoTo Son
    Application.EnableEvents = False
    
    If Cells(Target.Row, "F") = "İPTAL" Then
        Cells(Target.Row, "R") = IIf(Cells(Target.Row, "R") > 0, Cells(Target.Row, "R") * -1, Cells(Target.Row, "R"))
        Cells(Target.Row, "S") = IIf(Cells(Target.Row, "S") > 0, Cells(Target.Row, "S") * -1, Cells(Target.Row, "S"))
    End If
    
Son:
Application.EnableEvents = True
End Sub

. . .

 

[necip54]

. . .

Alt sekmedeki
KASIM2015 sayfa isminin üzerinder sağ tıkla > Kodları Görüntüle >
Açılan ekrana kodları yapıştırın.
B sütununa veri girerecek sonucu inceleyiniz.

. . .

alt sekmede Kasım2015 sayfasına sağ tıklayıp kodları görüntüleyip daha önceden olan başka kodun altına bu kodları kopyaldım ve isim girip denediğinde alınan hata mesajı:

Compile error:
Ambiguous name detected. WorkSheet_Change

 

[necip54]

çok teşekkür ederim, makro çalıştı. Konu çözülmüştür.

 

[ERMAN2853]

ElseIf vardiya = "GECE" Then
vardiyakod = "G"
baslamasaati = "23:30"
bitissaati = "06:30"
G1 yazdığım vardiyalar var 23:30-08:30 olarak göstermek istiyorum