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 13-10-2017, 21:06   #1
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan Aktif hücreyi büyük harf ile yazmak

Merhaba, herkese hayırlı geceler.

Ekte gönderdiğim excel dosyasında tablo yapmaya çalışıyorum, elimdeki örnek kodlarla yapmaya çalıştım, yapamadım.

Yapmak istediğim

Girdiğim veriler 3.satırdan başlıyor.
A sütununa B sütunundaki dolu hücreye göre sıra no vermek.
B sütunu, F sütunu ve H sütununda kelimeler nasıl yazılırsa yazılsın büyük harf olması.
G sütununa veri girildiğinde, cümlenin ilk harfinin büyük harf olmasını diğer harflerin küçük harfle olmasını istiyorum.

Yardımcı olur musunuz?
.
Eklenmiş Dosyalar
Dosya Türü: xlsm Örnek.xlsm (15.8 KB, 7 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 21:12   #2
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Forumda aşağıdaki kodu buldum ancak kendi sayfama uyarlıyamadım.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Son
    
    If Intersect(Target, [A:C]) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column > 3 Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Column = 1 Then
        Target = KucukHarf(Target.Value)
    ElseIf Target.Column = 2 Then
        Target = YazimDuzeniHarf(Target.Value)
    Else
        Target = BuyukHarf(Target.Value)
    End If
    
    Application.EnableEvents = True
    
Son:
End Sub

Function BuyukHarf(Veri As String)
    BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

Function KucukHarf(Veri As String)
    KucukHarf = LCase(Replace(Replace(Veri, "İ", "i"), "I", "ı"))
End Function

Function YazimDuzeniHarf(Veri As String)
    YazimDuzeniHarf = Application.WorksheetFunction.Proper(Veri)
End Function
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 21:46   #3
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Arkadaşlar G sütunu çok işlev gerektirebilir, G sütununa gerek yok o zaman.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 22:11   #4
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Aşağıdaki kodu B, F ve H sütunlarına nasıl uyarlarız? Veriler 3.satırdan başlıyor.


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

BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))

End Sub
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 22:29   #5
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,600
Excel Vers. ve Dili:
2010-2016
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Sut = Target.Column: Sat = Target.Row
If Sat > 2 And Sut = 2 Then
    If Cells(Sat, 2) <> "" Then
        Cells(Sat, 1) = WorksheetFunction.CountIf(Range("B3:B" & Sat), "<>")
        Exit Sub
    Else
        Cells(Sat, 1) = ""
        Exit Sub
    End If
End If
If Sat > 2 And Sut = 2 Or Sut = 6 Or Sut = 7 Then
    Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
    Exit Sub
End If
Application.ScreenUpdating = True
End Sub
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla
Eski 13-10-2017, 22:39   #6
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın askm, ilginiz için çok teşekkür ediyorum.

Göndermiş olduğunuz kodu uyguladığımda, A sütununda sıra numarasını veriyor, ancak B sütununda boş veriyi atlayarak sıra numarası veriyor.

B ve H sütunundaki veriyi büyük harf yazmıyor, sadece F sütunundaki veriyi büyük harf yazıyor.

Sizin kodların yaptığı işlemin resmini ve yapmak istediğimin resmini gönderiyorum.

Bu şekilde düzeltebilir misiniz?
Eklenmiş Resimler
Dosya Türü: jpg Resim.JPG (57.4 KB, 3 Görüntülenme)
Dosya Türü: jpg Yapmak istediğim.JPG (62.0 KB, 3 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 22:52   #7
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sıralama kodu aşağıdaki kod güzel çalışıyor ancak bu seferde aralara numara vermiyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
Target.Offset(0, -1).Value = Target.Row - 2
End Sub
Eklenmiş Resimler
Dosya Türü: jpg Numaralar boş.JPG (59.2 KB, 1 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-10-2017, 23:26   #8
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 1,600
Excel Vers. ve Dili:
2010-2016
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
Sut = Target.Column: Sat = Target.Row
If Sat > 2 And Sut = 2 Or Sut = 6 Or Sut = 7 Then
    If Sut = 2 Then
            Cells(Sat, 1) = Sat - 2
            Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
            Exit Sub
    Else
        Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
        Exit Sub
    End If
End If
End Sub
__________________
excel 2010- türkçe
askm Çevrimiçi   Alıntı Yaparak Cevapla
Eski 14-10-2017, 00:08   #9
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın askm, kod H sütununu büyük harf yapmıyor.
Ayrıca B sütununda bazı hücrelere plaka girmeyip, alt satıra plaka girdiğimde, B sütununda plaka olmayan yerlerin karşısı olan A sütununda sıra numarası yazmıyor.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-10-2017, 00:32   #10
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,523
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Arkadaşlar uzun uğraşlar sonucu elimde bulunan kodlarla aşağıdaki gibi yaptım, güzel çalışıyor.

Ancak bir sorun var, sıra numarası verirken sadece B,F,H sütunlarına veri girildiği zaman sıra numarası veriyor.

Aşağıdaki kodların içerisindeki If Intersect(Target, Range("B:H")) Is Nothing Then Exit Sub kısmını bu şekilde yaptığım zaman, B ile H sütunu arasındaki bütün verilerin hepsini büyük harf yapıyor.

Yapmak istediğim B, F ve H sütunundaki veri girdiğimde büyük harf yapsın,
B3 ile H sütunu arasına veri girdiğimde A3 sütununda sıra numarası versin.

Aşağıdaki kodu düzenleyebilir misiniz?

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ilk As String, son As String, deg As String
If Intersect(Target, Range("B:B,F:F,H:H")) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Column = 2 Then
    Target.Value = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
    Else
    Target.Value = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
End If
Application.EnableEvents = True


If Intersect(Target, [B3:H1048576]) Is Nothing Then Exit Sub

    Eski = WorksheetFunction.Max(3, Cells(Rows.Count, "A").End(3).Row)
    b = WorksheetFunction.Max(3, Cells(Rows.Count, "B").End(3).Row)
    c = WorksheetFunction.Max(3, Cells(Rows.Count, "C").End(3).Row)
    d = WorksheetFunction.Max(3, Cells(Rows.Count, "D").End(3).Row)
    e = WorksheetFunction.Max(3, Cells(Rows.Count, "E").End(3).Row)
    F = WorksheetFunction.Max(3, Cells(Rows.Count, "F").End(3).Row)
    g = WorksheetFunction.Max(3, Cells(Rows.Count, "G").End(3).Row)
    h = WorksheetFunction.Max(3, Cells(Rows.Count, "H").End(3).Row)
    
    Range("A3:A" & Eski).ClearContents
    son = WorksheetFunction.Max(b, c, d, e, F, g, h)
    For i = 3 To son
        Cells(i, "A") = i - 1
    Next
Application.ScreenUpdating = True
End Sub
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   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 19:15


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- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden