Makro ile sağa-sola yasla, ondalık sayısını artır-azalt

[CenTay]

Selamlar sayfada
eğer A1= 1 yada 2 yada 3 ise ; c7 ile c30 arasındaki sayıların ondalık basamak sayısını 2 azalt,
eğer A1= 4 ise ; d35 d38 aralığını sola yasla,
eğer A1= 5 ise ; c7 ile c30 aralığını ondalık sayısını 2 artır, eğer A1= 6 ise ; d35 ile d38 aralığını sağa yasla yapan butonu bir makro yazmanız rica ediyorum.Teşekkürler.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırrısanız A1 hücresi değiştiğinde sayfada istediğiniz gibi değişiklikler olacaktır.

Ancak ondalık basamak sayısını 2 arttırma ya da iki azaltma şeklinde kod yazamadım. Tahminen 2 azaltmadan kastınızın 100, iki arttırmadan kastınızın da 100,00 biçimi olacağını düşünerek kodu düzenledim. Siz de isterseniz kodlardaki kırmızı kısımları değiştirerek basamak sayısını ayarlayabilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub

If Target = 1 Or Target = 2 Or Target = 3 Then
    [C7:C30].NumberFormat = "[COLOR="Red"][B]0[/B][/COLOR]"
Else
If Target = 4 Then
    [D35:D38].HorizontalAlignment = xlLeft
Else
If Target = 5 Then
    [C7:C30].NumberFormat = "[COLOR="red"][B]0.00[/B][/COLOR]"
Else
If Target = 6 Then
    [D35:D38].HorizontalAlignment = xlRight
End If
End If
End If
End If
End Sub

 

[CenTay]

Yusuf hocam selamlar doğru anlamışsınız şimdi baktım da sayfada başka kod var çakıştı , şöyle olur mu Sayfa adı ; rapor_al olsun ve kod modül de olsun hata için af dilerim hocam Teşekkürler

 

[YUSUF44]

Örnek dosya yüklerseniz daha iyi olur. Mevcut kodları görmeden yapılacak değişiklikler sorunu daha da büyütebilir.

 

[CenTay]

Hocam sağolasın, dosya çok büyük, ama sayfadaki kodu ekleyim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1,E1]) Is Nothing Then Exit Sub
If Target = "" Or [D1] > [E1] Then
MsgBox "D1 hücresindeki tarih E1 hücresindeki tarihten büyük olamaz." & vbLf & _
"D1 ve E1 hücreleri boş bırakılamaz." & vbLf & vbLf & _
"Tarihleri Kontrol Ederek Yeniden Yazınız."
Range("A730").ClearContents
Exit Sub
End If
Call listele
End Sub

Kodun ilk satırı için hata veriyor, o yüzden modüle yazabilirmiyiz demiştim.Teşekkürler

 

[YUSUF44]

İki kodun birleşimi aşağıdaki şekilde:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then GoTo 10

If Target = 1 Or Target = 2 Or Target = 3 Then
    [C7:C30].NumberFormat = "0"
Else
If Target = 4 Then
    [D35:D38].HorizontalAlignment = xlLeft
Else
If Target = 5 Then
    [C7:C30].NumberFormat = "0.00"
Else
If Target = 6 Then
    [D35:D38].HorizontalAlignment = xlRight
End If
End If
End If
End If
10:
If Intersect(Target, [D1,E1]) Is Nothing Then Exit Sub

If Target = "" Or [D1] > [E1] Then
    MsgBox "D1 hücresindeki tarih E1 hücresindeki tarihten büyük olamaz." & vbLf & _
    "D1 ve E1 hücreleri boş bırakılamaz." & vbLf & vbLf & _
    "Tarihleri Kontrol Ederek Yeniden Yazınız."
    Range("A7:D30").ClearContents
    Exit Sub
End If
Call listele
End Sub

 

[Ömer BARAN]

Merhaba.

YUSUF Bey'in müsadeleriyle.

Sayın Centay sanırım, daha önce benim düzenlemesini yaptığım kodları kullandığı
Koşullu Listeleme belgesinde kullanmak üzere destek istemek için konu açmış.

Eğer öyleyse;
-- listele kod'unun sonuna (End Sub satırından önce)
aşağıdaki satırları (YUSUF Bey'in gönderdiği kodlardan hareketle) ekleyip,
-- aynı kod'daki 65536 sayılarını (2 adet) 35 olarak değiştirince istediğiniz sonucu almanız lazım.
.

If [A1] = 1 Or [A1] = 2 Or [A1] = 3 Then
    [C7:C30].NumberFormat = "0"
        Else
            If [A1] = 4 Then
                [D35:D38].HorizontalAlignment = xlLeft
                    Else
                        If [A1] = 5 Then
                            [C7:C30].NumberFormat = "0.00"
                        Else
                    If [A1] = 6 Then
                [D35:D38].HorizontalAlignment = xlRight
            End If
        End If
    End If
End If

 

[CenTay]

Sevgili yusuf44 ve Ömer Baran hocam çok çok teşekkür ediyorum sağolun varolun Allah ne muradınız varsa versin