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 01-01-2018, 18:09   #1
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan Kod düzenleme

Merhaba, herkese hayırlı akşamlar.

Ekte gönderdiğim excel dosyamdaki makrolar gayet güzel çalışıyor, ancak aşağıdaki makro satırını değiştirdiğim zaman çalışmıyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
If Intersect(Target, Range("B2:F" & Rows.Count)) Is Nothing Then Exit Sub
Bu şekilde yaptığım zaman çalışmıyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
If Intersect(Target, Range("B2:B,F2:F" & Rows.Count)) Is Nothing Then Exit Sub
Yardımcı olur musunuz?

Kodun tamamı.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Intersect(Target, Range("B2:F" & Rows.Count)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    
    Select Case Target.Column
        Case 2, 6
        Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
    End Select
    
    Sheets(1).Range("A2:A" & [A1048576].End(3).Row).ClearContents
    son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("A2") = 1
    Range("A2").AutoFill Destination:=Range("A2:A" & son), Type:=xlFillSeries
    Sheets(1).Range("A1:F1048576").Borders.LineStyle = xlNone 'Kenarlık sil
    Sheets(1).Range("A1:F" & [B1048576].End(3).Row).Borders.LineStyle = xlContinuous 'Kenarlık
    
10
    Application.EnableEvents = True
End Sub
Eklenmiş Dosyalar
Dosya Türü: xlsm ÖRNEK1.xlsm (21.3 KB, 8 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-01-2018, 19:01   #2
muygun
Özel Üye
 
muygun kullanıcısının avatarı
 
Giriş: 06/07/2004
Mesaj: 6,892
Excel Vers. ve Dili:
Excel-2003 Türkçe
Varsayılan

Merhaba;
İlgili satırı;

If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count)) Is Nothing Then Exit Sub

Şeklinde düzenleyin.

İyi çalışmalar.
__________________
Excel-2003 - Türkçe
muygun Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-01-2018, 19:09   #3
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın muygun, ilginiz için çok teşekkür ediyorum, ellerinize sağlık, sayenizde gayet güzel oldu.

Göndermiş olduğum örnekteki kodda şöyle bir sıkıntı çıkıyor, F sütunundan sonraki sütunlardaki hücrelerde veriler mevcut, B sütunu ve F sütununa bilgi girildiğinde F sütunundan sonraki sütunlardaki verileri A sütunundaki sıra numarası veren kod görüyor ve en son satıra kadar sayı veriyor.

Sıra numarasını veren koduda B ve F sütununa göre ayarlayabilir misiniz?
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-01-2018, 19:20   #4
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın muygun, sizin göndermiş olduğunuz koda başka sayfadaki kodlarda bulunan H sütunu için de ekleme yapınca hata mesajı verdi.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count, "H2:H" & Rows.Count)) Is Nothing Then Exit Sub
Eklenmiş Resimler
Dosya Türü: jpg Ekran Alıntısı.JPG (92.1 KB, 3 Görüntülenme)
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-01-2018, 19:26   #5
muygun
Özel Üye
 
muygun kullanıcısının avatarı
 
Giriş: 06/07/2004
Mesaj: 6,892
Excel Vers. ve Dili:
Excel-2003 Türkçe
Varsayılan

Merhaba;
Tam anlayamadım ama;

Private Sub Worksheet_Change(ByVal Target As Range)
sat = Target.Row
On Error GoTo 10
If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count)) Is Nothing Then Exit Sub
Application.EnableEvents = False

Select Case Target.Column
Case 2, 6
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
End Select

Sheets(1).Range("A2:A" & [A1048576].End(3).Row).ClearContents
son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Range("A2") = 1
Range("A2").AutoFill Destination:=Range("A2:A" & son), Type:=xlFillSeries
Sheets(1).Range("A1:F1048576").Borders.LineStyle = xlNone 'Kenarlık sil
Sheets(1).Range("A1:F" & [B1048576].End(3).Row).Borders.LineStyle = xlContinuous 'Kenarlık

10
Cells(sat, 1) = sat - 1
Application.EnableEvents = True
End Sub

Şeklinde bir deneyin.
__________________
Excel-2003 - Türkçe
muygun Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-01-2018, 19:37   #6
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Sayın muygun, ellerinize sağlık çok teşekkür ediyorum.

4. mesajımdaki hatayı veriyor.
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-01-2018, 00:10   #7
saban20152015
 
Giriş: 06/07/2015
Mesaj: 563
Excel Vers. ve Dili:
2003
Varsayılan

Range ifadesine 2 değişken tanımlanır diye biliyorum. Sizde 3 olmuş. B,F ve H.
__________________
İnsanlık, para karşısında bugün de değer kaybetti.
saban20152015 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-01-2018, 00:12   #8
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

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

Peki kodu nasıl 3 sütuna uygularız?
__________________
.
Her zaman yardımcı olmak güzel bir şeydir...
ASLAN7410 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-01-2018, 00:13   #9
saban20152015
 
Giriş: 06/07/2015
Mesaj: 563
Excel Vers. ve Dili:
2003
Varsayılan

Özel üye olmadığımdan dosyanızı inceleyemiyorum. Bir upload sitesine ekleme şansınız olursa bir bakayım. Elimden bir şey gelirse ...
__________________
İnsanlık, para karşısında bugün de değer kaybetti.
saban20152015 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-01-2018, 00:17   #10
ASLAN7410
Altın Üye
 
ASLAN7410 kullanıcısının avatarı
 
Giriş: 15/07/2012
Şehir: Aslan ERASLAN - ANKARA
Mesaj: 1,668
Excel Vers. ve Dili:
Ofis 2013 Türkçe
Varsayılan

Dosya ekte.


Kodun sadece 3 sütunda çalışmasını istiyordum.

http://dosya.co/185sidv83so1/ÖRNEK1_(1).xlsm.html
__________________
.
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 18:39


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden