Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 10-11-2017, 15:01   #1
sirkülasyon
Altın Üye
 
sirkülasyon kullanıcısının avatarı
 
Giriş: 10/07/2012
Şehir: Malatya / Hekimhan
Mesaj: 934
Excel Vers. ve Dili:
2016 TR
Varsayılan Makro ile hücreye veri girilince arka planı renklendirme

Selamün Aleyküm

Örneğin
H5 hücresine rakam girdiğim zaman
A5:AA5 satırı olduğu gibi arka planı "%15 Koyu Beyaz" olacak şekilde yapmak istiyorum.

Bu makro
A5 :AA150 aralığında bulunan her satır için geçerli olacak şekilde olabilmesi için Makro konusunda rica etsem yardımcı olabilir misiniz?

Teşekkür eder saygılarımı sunarım.
sirkülasyon Çevrimiçi   Alıntı Yaparak Cevapla
Eski 10-11-2017, 15:19   #2
Ömer
Moderatör
 
Ömer kullanıcısının avatarı
 
Giriş: 18/08/2007
Şehir: Kuşadası
Mesaj: 18,999
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Merhaba,

Sayfanın kod bölümüne kopyalayıp yapıştırın.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [H5:H150]) Is Nothing Then Exit Sub
    
    If Target.Count > 1 Then Exit Sub
    With Cells(Target.Row, "A").Resize(1, 27).Interior
        .ColorIndex = xlNone
        If IsNumeric(Target) = True And Target <> "" Then
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.15
        End If
    End With
    
End Sub
.
__________________
.
Ömer Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-11-2017, 15:47   #3
sirkülasyon
Altın Üye
 
sirkülasyon kullanıcısının avatarı
 
Giriş: 10/07/2012
Şehir: Malatya / Hekimhan
Mesaj: 934
Excel Vers. ve Dili:
2016 TR
Varsayılan

Ömer abi
başka sayfada Kod sıkıntısız çalışıyor ancak kendi sayfasına aldığım zaman

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row > 4 And Target.Column = 9 Then
    If Target.Value <> "" Then
        If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
            
            Target.Offset(0, 1) = Format(WorksheetFunction.Round((Target * 1.08), 2), "#,##0.00")

            Target.Offset(0, 2) = Format(WorksheetFunction.Round((Target.Offset(0, 1) - Target), 2), "#,##0.00")
            Target.Offset(0, 3) = Format(WorksheetFunction.Round((Target.Offset(0, 2) / 2), 2), "#,##0.00")
            Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
        Else
            Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
            Target.Offset(0, 1) = ""
            Target.Offset(0, 2) = ""
            Target.Offset(0, 3) = ""
          
        End If
    Else
        Target.Offset(0, 1) = Empty
    End If
End If
End Sub
makrosu var olduğu için

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [H5:H150]) Is Nothing Then Exit Sub
    
    If Target.Count > 1 Then Exit Sub
    With Cells(Target.Row, "A").Resize(1, 27).Interior
        .ColorIndex = xlNone
        If IsNumeric(Target) = True And Target <> "" Then
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.15
        End If
    End With
    
End Sub
kodunu modüle eklediğim de
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
kısmı hata veriyor bu sebeple makro çalışmıyor.

Allah sizden razı olsun. Özür dileyerek yukarıda yer alan Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan kodları birleştirebilir misiniz?
sirkülasyon Çevrimiçi   Alıntı Yaparak Cevapla
Eski 11-11-2017, 09:31   #4
Ömer
Moderatör
 
Ömer kullanıcısının avatarı
 
Giriş: 18/08/2007
Şehir: Kuşadası
Mesaj: 18,999
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Bu şekilde deneyin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    If Target.Row > 4 And Target.Column = 9 Then
        If Target.Value <> "" Then
            If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
                
                Target.Offset(0, 1) = Format(WorksheetFunction.Round((Target * 1.08), 2), "#,##0.00")
    
                Target.Offset(0, 2) = Format(WorksheetFunction.Round((Target.Offset(0, 1) - Target), 2), "#,##0.00")
                Target.Offset(0, 3) = Format(WorksheetFunction.Round((Target.Offset(0, 2) / 2), 2), "#,##0.00")
                Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
            Else
                Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
                Target.Offset(0, 1) = ""
                Target.Offset(0, 2) = ""
                Target.Offset(0, 3) = ""
              
            End If
        Else
            Target.Offset(0, 1) = Empty
        End If
    End If
    
    If Target.Row > 4 And Target.Column = 8 Then
        If Target.Count > 1 Then Exit Sub
        With Cells(Target.Row, "A").Resize(1, 27).Interior
            .ColorIndex = xlNone
            If IsNumeric(Target) = True And Target <> "" Then
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.15
            End If
        End With
    End If
    
End Sub
.
__________________
.
Ömer Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-11-2017, 06:57   #5
sirkülasyon
Altın Üye
 
sirkülasyon kullanıcısının avatarı
 
Giriş: 10/07/2012
Şehir: Malatya / Hekimhan
Mesaj: 934
Excel Vers. ve Dili:
2016 TR
Varsayılan

Ömer Abi
Teşekkür Ederim.
Ellerine Sağlık. Hakkını Helal Et.
sirkülasyon Çevrimiçi   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 14:23


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden