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 04-02-2018, 05:07   #1
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan çok sütunlu veri doğrulama

Merhaba,

değerli uzman arkadaşlarım

yapmak istediğim fakat uyarlayamadığım bir konu var.

Gelişmiş filtre tabanlı yapmaya çalıştığım bir programda belli hücrelere veri doğrulama atadım. Aşağıda ki kod ile bir sütunda ki değerleri benzersiz olarak veri doğrulama içine getiriyor.
Örneğin bu aralığı kendi tanımlayacağım şekilde aynı anda a,c,d,e,f vs sütünlara uygulamam gerekirse nasıl düzenlemeliyim.
aynı anda c sütununda ki verileri b4 hücresine veri doğrulama ile tanımlayacak
e sütununda ki verileri b5 hücresine tanımlayacak gibi
ben bunu bu şekilde devam ettireceğim
yardımcı olabilirseniz sevinirim

Sub veridoğrulama()
Dim i%, c&, say%, arr()
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("C1:C" & i), Cells(i, "C")) = 1 Then
say = say + 1
ReDim Preserve arr(1 To say)
For c = 1 To UBound(arr)
arr(say) = Cells(i, "C").Value
Next c
End If
Next i
Range("B4").Validation.Delete
Range("B4").Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",")

End Sub
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 16:11   #2
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan

Tekrar Merhaba,

Bu kodlama veya kodu düzenleme hakkında mutlaka Uzman bir arkadaşın bilgisi vardır diye düşünüyorum.

Yardımcı olabilirmisiniz lütfen

Teşekkürler
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 16:13   #3
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,363
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Aşağıdaki gibi denermisiniz?
Kırmızı (6) "F" sütunu dahil, mavi ile bölüm ile "B" sütunu atlanacak
(2. satırların hepsinde dolu olduğu varsayılarak)
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub veridoğrulama()
Dim i%, c&, say%, arr()
Dim x As Long, rw As Long
Dim j As Integer
For x = 1 To 6
If Cells(2, x) <> "" Then
If x = 2 Then x = x + 1
rw = Cells(Rows.Count, x).End(xlUp).Row
For i = 2 To rw
If WorksheetFunction.CountIf(Range(Cells(1, x), Cells(i, x)), Cells(i, x)) = 1 Then
say = say + 1
ReDim Preserve arr(1 To say)
For c = 1 To UBound(arr)
arr(say) = Cells(i, x).Value
Next c: End If: Next i
j = j + 1
Range("B" & 3 + j).Validation.Delete
Range("B" & 3 + j).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",")
Erase arr: say = 0
End If: Next
End Sub
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 16:24   #4
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan

Cevap verdiğiniz için Teşekkürler Sayın Plint

Yalnız şu şekilde bir problem oldu

o sütunlardaki benzersizlerin tamamını b4 hücresi içinde ki veri doğrulamada gösterdi.

Olmasını rica ettiğim ise örneğin e sütununda ki verilerin b5 hücresinde veri doğrulama ile benzersizlerinin listelenmesi.
h sütununda ki verilerin b6 hücresinde veri doğrulama ile benzersiz listelenmesi gibi uzayacak.
Bunu istememin sebebi veri doğrulama ile seçtikçe makro otomatik tetikliyor ve filtre uygulandığı için bir alttaki seçenekte, aranacak data daralıyor bu bu şekilde eriyerek dinamik olarak güncelleniyor.
Bunu makro kaydet benzersizleri kaldır ve veri doğrulama içinde kaydır ve bağ değ dolu say ile çözmeye çalıştım fakat hem çok ağır çalıştı hemde verilerde ne kadar düzeltmeye çalışsamda bir ço hücre kayma oluyor

Talep ettiğim kodun nasıl revize edilmesi gerektiğini öğretirseniz veya yolu gösterirseniz çok minnettar kalırım.

Bir çok kitap kurcaladım burada da bir çok çözülmüş soru üzerinden uyarlamaya çalıştım fakat bir türlü yapamadım

Teşekkürler
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 16:31   #5
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan

Dosyayı da ekledim Sayın Plint

aşağıda ki filtrelenmiş verileri göre uyarlamaya açlışıyorum.

Teşekkürler
Eklenmiş Dosyalar
Dosya Türü: rar AÇIK - Kopya2.rar (169.3 KB, 11 Görüntülenme)
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 16:54   #6
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,363
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Örnek dosyanızı burayada ekleyip indirme adresi verirmisiniz, yukarıdaki dosyayı indirme yetkim yok
Filtre sütunlar içinde aşağıdaki gibi yapabiliriz, olmazsa dosyayıda ilgili adrese eklersiniz
(filtrelendikten sonra ilgili sütunun ikinci satırdan itibaren boş kalmayacağı varsayılarak)

http://s7.dosya.tc/server2/fvcx9w/veri.zip.html


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub veridoğrulama()
Dim i%, c&, say%, arr()
Dim x As Long, rw As Long
Dim j As Integer
Dim s, veri As Range
For x = 1 To 6
If x = 2 Then x = x + 1
Set veri = Columns(x).SpecialCells(xlCellTypeVisible).Cells.SpecialCells(xlCellTypeConstants, 23).Cells
For Each s In veri
If s.Row <> 1 Then
If WorksheetFunction.CountIf(Range(Cells(1, x), Cells(s.Row, x)), s.Value) = 1 Then
say = say + 1
ReDim Preserve arr(1 To say)
For c = 1 To UBound(arr)
arr(say) = s.Value
Next c: End If: End If: Next s
j = j + 1
Range("B" & 3 + j).Validation.Delete
Range("B" & 3 + j).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",")
Erase arr: say = 0:
 Next
End Sub

Bu mesaj en son " 04-02-2018 " tarihinde saat 17:02 itibariyle PLİNT tarafından düzenlenmiştir....
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 17:31   #7
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan

İlgili adrese yükledim dosyayı

teşekkürler

http://s7.dosya.tc/server2/uzcbqr/AC...opya2.rar.html
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 20:54   #8
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,363
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba

Ek dosyayı deneyin eklenen kodlar "Filtre" sayfasının, kod penceresinde
"B4:B14" aralığında hücre seçildiğinde duruma göre kendini yenilecektir
İlgili aralıkta seçili veri yoksa "Sayfa1" den, varsa "Filtre" sayfasından veri doğrulama değerleri eklenecek
http://s7.dosya.tc/server2/ajmhfe/AC...opya3.zip.html
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 20:56   #9
bunyaming
Altın Üye
 
Giriş: 13/01/2017
Şehir: Kocaeli
Mesaj: 56
Excel Vers. ve Dili:
2010 türkçe
Varsayılan

Teşekkürler Sayın Plint

mükemmel olmuş yazdığınız kodları inceleyip arşivim de mutlaka bulunduracağım.

Desteğiniz ve katkılarınız için minnettarım

iyi akşamlar
bunyaming Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-02-2018, 21:08   #10
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,363
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Alıntı:
bunyaming tarafından gönderildi Mesajı Görüntüle
Teşekkürler Sayın Plint

mükemmel olmuş yazdığınız kodları inceleyip arşivim de mutlaka bulunduracağım.

Desteğiniz ve katkılarınız için minnettarım
iyi akşamla
r
Rica ederim. Güle güle kullanın.
İsteğiniz şeklin tam olarak nasıl olduğu konusunda biraz kararsız kaldım ama böyle bir sonucun dosyanıza uygun olacağını düşündüm, eğer "Sayfa1" de dolu satır sayısı çok olmayacaksa bu şekilde yeterli olacaktır, olmazsa değişiklik/ek yaparız.
İşlerinizde kolaylıklar dilerim.
PLİNT Ç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 12:37


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 - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu 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- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden