• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Benzer Değerler

  • Konbuyu başlatan Konbuyu başlatan kaanil
  • Başlangıç tarihi Başlangıç tarihi
K

kaanil

Katılım
11 Mart 2009
Mesajlar
19
Excel Vers. ve Dili
365 Eng.
Merhaba Arkadaşlar,
Aşağıdaki gibi A, B ve C sütunlarından oluşan bir tablom var. Bu üç sütundaki değerleri tekrar eden değerleri içermeyecek şekilde tek bir sütunda birleştirmek istiyorum.

NOT. Tabloda aşağıya doğru sürekli veri girildiğinden veri girildikçe otomatik olarak oluşturulan sütunu güncellemesi gerekmektedir.

A/ B / C
105 / 666 /
105 / 666 / 721
105 / 666 /
105 / 666 /
105 / 666 /
17 / 769 /
17 / 769 /
17 / 769 /
17 / 769 /
17 / 769 /
17 / 769 /
17 / 769 /
17 / 769 /
584 / 666 /
666 / /
584 / /
666 / /
584 / /
769 / 790 /
769 / 790 /
769 / 790 /
769 / 790 /
769 / 790 /
105 / 666 /
105 / 666 /
584 / 728 / 666

Şimdiden teşekkürler,
 
Son düzenleme:
Merhaba.

-- Alt taraftan uygulama istediğiniz sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında, sağ taraftaki boş alana aşağıdaki kodları yapıştırın,
-- Ok tuşlarını kullanarak Sub TEKSUT() başlıklı satıra gelince bir kez F5 tuşuna basın,
(bu işlem mevcut verilerin D sütununa tekrarsız olarak listelenmesini sağlayacak)
-- Private Sub Worksheet_Change başlıklı diğer kod kısmı ise; A, B ve C sütunlarından herhangi birine veri yazdıkça;
bu veri daha önce yazılmamışsa D sütunundaki listenin sonuna otomatik olarak ekleyecektir.

Listeleme işlemi D sütununa yapılır.
.
Kod: 
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [A:C]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("D:D"), Target) = 0 Then _
                Cells([D65536].End(3).Row + 1, "D") = Target
[COLOR="blue"]If Target = "" And [E1] <> "" And _
    WorksheetFunction.CountIf(Range("A:C"), [E1]) = 0 Then _
Cells(WorksheetFunction.Match([E1], Range("D:D"), 0), "D").Delete Shift:=xlUp
[E1] = ""[/COLOR]
[B]End Sub[/B]

[COLOR="Blue"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
If Intersect(Target, [A:C]) Is Nothing Then Exit Sub
[E1] = Target.Value
[B]End Sub[/B][/COLOR]

[B]Sub TEKSUT()[/B]
Range("D:D").ClearContents
For sut = 1 To 3
    Range(Cells(2, sut), Cells(Cells(65536, sut).End(3).Row, sut)).Copy Cells([D65536].End(3).Row + 1, "D")
Next
For sat = [D65536].End(3).Row To 2 Step -1
    If Cells(sat, "D") = "" Or Cells(sat, "D") = " " Then Cells(sat, "D").Delete Shift:=xlUp
Next
    Range("D1:D" & [D65536].End(3).Row).RemoveDuplicates Columns:=1, Header:=xlYes
MsgBox "Mevcut veriler D sütununa tekrarsız olarak listelendi." & vbLf & _
    "Artık A, B veya C sütununa, daha evvel yazılmamış bir veri yazılırsa;" & vbLf & _
    "D sütununa otomatik olarak eklenecek.", vbInformation, "..:: O.BARAN ::.."
[B]End Sub[/B][/FONT]
 
Çok teşekkür ederim Ömer Bey,
Tablomu geliştireceğim ve sütun yerlerinin değişme ihtimali yüksek ve her seferinde sormamak adına bunu formül ile yapmak mümkün müdür?

Makrolardan anlamıyorum ve benzer durumlar için uyarlama yapamıyorum fakat formüllerde bir şekilde uyarlıyorum.

Not. Yanlışlık ile yazılmış olan değer listeye ekleniyor fakat düzeltildiğinde listen silinmiyor.
 
Son düzenleme:
Tekrar merhaba.

Not kısmında belirttiğiniz, yanlışlıkla yazılanın silinmesi durumu ile ilgili olarak önceki kod cevabı güncelledim,
(mavi kısımlar eklendi) sayfayı yenileyerek kontrol ediniz.
Eklediğim kısımlar sayfadaki E1 hücresini de kullandığından o hücreye veri yazmayınız.

Diğer hususla ilgili olarak ise şunları söylemeliyim:
Sorunuzu, gerçek belgenizin tasarımını tamamladıktan sonra
ve gerçek belgenizle aynı yapıda örnek belge üzerinden sorunuz.
(sayfa/satır/sütun/veri başlangıç satırı/metin-sayı-tarih vs hücre biçimleri gibi)

Örnek belge yükleme yöntemine ilişkin açıklamalar cevaplarımın altındaki İMZA bölümünde var.

Başı-sonu/sayfa yapısı/işlem yapılacak sütunların hangileri olduğu/verideki satır sayısı gibi
bilinmezlerin olduğu bir soru için verilecek formül cevaplarının ihtiyacınızı karşılayacağını düşünmüyorum.
.
 
Merhabalar,
Ömer Bey'in sunumuna alternatif olsun.
Verilerinizin A2:C6 aralığında olduğu düşünülmüştür.Siz kendinize göre ayarlarsınız.
Kod: 
İNDİS(A$2:C$6;KÜÇÜK(EĞER(EĞERSAY(A$2:C$6;A$2:C$6)=1;
  SATIR(A$1:A$5));SATIR(D1));YUVARLA(MOD(
    KÜÇÜK(EĞER(EĞERSAY(A$2:C$6;A$2:C$6)=1;
SATIR(A$2:A$6)+SÜTUN(A$2:C$6)/100);SATIR(D1));1)*100;))
[COLOR="Blue"]Formül dizi formülüdür.CTRL+SHIFT+ENTER ile tamamlayınız.[/COLOR]

Saygılar,
Şeşen
 
Sayın bzace teşekkür ederim,

A2:C6 arasına verileri girerek formülü D1 hücresine kopyaladım. Dizi formül olacak şekilde girişi yaptım A2 hücresindeki değeri verdi. Fakat aşağıya uzattığımda hep A2 hücresindeki değeri döndürdü.

Nerede hata yapıyorum?
 
Merhaba.

Örnek belgenize kodlar uyarlanmıştır.
(makroları etkinleştirmeyi unutmayınız)
Hazırladığım belgeye buradan erişebilirsiniz.

Ben olsam, benzersiz veri listesini her veri girişinde güncellemek yerine;
-- Private Sub Worksheet_Change(ByVal Target As Range) ve
-- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
kodlarını silip, sadece TEKSUT makrosunu kullanırdım
(VERİ sayfasına bir DÜĞME ekleyip bu düğmeyle TEKSUT makrosunu çalıştırırdım).

İstediğim anda bu düğmeye tıklayarak da benzersiz veri listesini elde ederdim.

Tabi tercih sizin.
.
 

Ekli dosyalar

Ömer Bey ve bzace yardımlarınız ve uğraşlarınız için çok teşekkür ederim.
Ömer Bey'in vermiş olduğu kodlar ile çözümü sağladım.

Ellerinize sağlık,
 
Ömer Bey,
Sizi son kez rahatsız ediyorum.

Vermiş olduğunuz kodda sütun değiştirmek istesem kodun hangi bölümünde değişiklik yapmam gerekecektir? Aşağıda sarı ile belirlediğim kısımlara yeni sütun aralıklarını yazamam yeterli midir? Denedim ("AI5:AL") beceremedim.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set s5 = Sheets("Sayfa5")
son = [B65536].End(3).Row
sat = s5.[B65536].End(3).Row + 1
If Intersect(Target, Range("[COLOR="Yellow"]Z5:AC[/COLOR]" & son)) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(s5.Range("B:B"), Target) = 0 Then _
                s5.Cells(sat, "B") = Target
If Target = "" And s5.[A1] <> "" And _
    WorksheetFunction.CountIf(Range("[COLOR="yellow"]Z5:AC[/COLOR]" & son), s5.[A1]) = 0 Then _
s5.Cells(WorksheetFunction.Match(s5.[A1], s5.Range("B:B"), 0), "B").Delete Shift:=xlUp
s5.[A1] = ""
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
son = [B65536].End(3).Row
If Intersect(Target, Range("[COLOR="yellow"]Z5:AC[/COLOR]" & son)) Is Nothing Then Exit Sub
Sheets("Sayfa5").[A1] = Target.Value
End Sub

Sub TEKSUT()
Set s5 = Sheets("Sayfa5"): Set v = Sheets("VERİ")
s5.Range("B:B").ClearContents: s5.[B1] = "LİSTE"
For sut = 26 To 29
    v.Range(v.Cells(5, sut), v.Cells(v.Cells(65536, sut).End(3).Row, sut)).Copy s5.Cells(s5.[B65536].End(3).Row + 1, "B")
Next
For sat = s5.[B65536].End(3).Row To 2 Step -1
    If s5.Cells(sat, "B") = "" Or s5.Cells(sat, "B") = " " Then s5.Cells(sat, "B").Delete Shift:=xlUp
Next
    s5.Range("B1:B" & s5.[B65536].End(3).Row).RemoveDuplicates Columns:=1, Header:=xlYes
MsgBox "Mevcut veriler B sütununa tekrarsız olarak listelendi." & vbLf & _
    "Artık VERİ sayfasında, Z, AA, AB veya AC sütunlarına," & vbLf & _
    "daha evvel yazılmamış bir veri yazılırsa;" & vbLf & _
    "Sayfa5 B sütununa otomatik olarak eklenecek.", vbInformation, "..:: O.BARAN ::.."
End Sub
 
Son düzenleme:
Tekrar merhaba.

-- Veri başlangıç satırı 5 olduğundan ve işlem uygulanacak ilk sütun Z sütunu olduğundan => Z5
-- Kod'un üçüncü satırında yer alan son değişkeni, B sütunundaki son dolu satırı buluyor,
-- Son veri sütunu (Z'den itibaren aralıksız olarak) AC olduğundan => AC
Sonuçta kod'un işlem yapacağı alan Z5:AC... B sütunundaki son dolu satır.
-- Ayrıca TEKSUT kod'undaki For sut = 26 To 29 satırındaki sayılar Z ve AC sütununun sütun numaralarıdır.

Aralıksız olarak başka sütunlarda işlem yaptırma isterseniz sütun adlarının değiştirilmesi yeterli olur.
Tabi unutulmaması gereken şey Worksheet_Change kodları; manuel veri girişi yapıldığında çalışır.
Bu hücrelerde formül varsa, formül sonucunun değişmesi, bu hücrenin değişmesi anlamına gelmez ve kod tetiklenmez.

Formül içeriğine bakarak, hücreyi etkileyen hücreler ... üzerinden kod oluşturulmalıdır.
(orada da manuel veri girişi yoksa, oradaki formülleri etkileyen hücreler....)

Daha evvel de belirtmiştim; tavsiyem işlem yaptıkça benzersiz liste oluşturmak değil,
ihtiyaç oldukça TEKSUT kod'unu çalıştırmak yönünde. Böyle yaparsanız kod düğme ile
tetikleneceğinden formüllü hücre/elle veri girilen hücre olayının bir önemi kalmıyor.
TEKSUT makrosanda, durumua göre sadece kopyalama yöntemini değiştirmek gerekebilir.
 
Ömer Bey,
Tüm yardımlarınız, emeğiniz ve vakit ayırdığınız için teşekkür ederim.

"TEKSUT kod'undaki For sut = 26 To 29" sütun numaraları olduğunu bilmiyordum. Onları düzeltince çalıştı.

İyi günler, çalışmalar,
 
kaanil' Alıntı:
Ömer Bey,
Tüm yardımlarınız, emeğiniz ve vakit ayırdığınız için teşekkür ederim.
"TEKSUT kod'undaki For sut = 26 To 29" sütun numaraları olduğunu bilmiyordum. Onları düzeltince çalıştı.
İyi günler, çalışmalar,
Genişletmek için tıkla ...
İhtiyaç görüldüyse mesele yok.

Kolay gelsin.
.
 
Sayın Bzace tarafından düzenlenen dizi formülündeki alan kısıtlaması kaldırıldı.
formül E1 hücresine uygulanıp dizi formülü oluşturulup aşağı sürüklenince tek olan değerleri getirmektedir.SADECE tek değer olmayan formül satırında #SAYI! HATASI NASIL GİDERİLEBİLİR. Sayın BZACE lütfen bunu lütfen çözebilir misiniz?
Kod: 
=İNDİS(A:C;KÜÇÜK(EĞER(EĞERSAY(A:C;A:C)=1;  SATIR(A:A));SATIR(E1));YUVARLA(MOD(KÜÇÜK(EĞER(EĞERSAY(A:C;A:C)=1;SATIR(A:A)+SÜTUN(A:C)/100);SATIR(E1));1)*100;))
 
Tek sutun için alternatif kod

Kod: 
Sub teksut1()

Dim say
Set S1 = Sheets("VERİ") ' veri sayfası
Set S2 = Sheets("Sayfa5") 'aktarılan sayfa

S2.Range("b2:b" & Rows.Count).ClearContents

ReDim ara1(65000): ReDim ara2(65000):

For j = 26 To 29
For m = 5 To S1.Cells(Rows.Count, j).End(3).Row
If WorksheetFunction.Trim(S1.Cells(m, j)) <> "" Then
say = say + 1
ara1(say) = WorksheetFunction.Trim(S1.Cells(m, j))
ara2(say) = 1
End If
Next m
Next j

sat1 = 1

For r = 1 To say
aranan1 = ara1(r)
If ara2(r) = 1 Then
For i = r To say
If ara1(i) = aranan1 Then
ara2(i) = 0
End If
Next i
sat1 = sat1 + 1
S2.Cells(sat1, 2).Value = aranan1
End If
Next r

MsgBox "İşleminiz tamamlanmıştır."

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst