• DİKKAT

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

verileri sınıflandırma yardım ederseniz sevinirim

  • Konbuyu başlatan Konbuyu başlatan zodiak
  • Başlangıç tarihi Başlangıç tarihi
Bir el atarsanız çok memnun olurum

arkadaşlar bir şeyler yapıyorum ama bazı mantıkları yürütemiyorum bana bir yardım ederseniz çok sevinirim korhan aktar hocamın kodu bu bu kodu bir sonraki örenkteki tabela xls ye uygulayamadım yardım edermisiniz...
 

Ekli dosyalar

tabela xls

yukarıdaki msg de verdiğim kodu burada açıkladığım gibi uygulamamız mümkünmü şimdiden çoook teşekkür ederim
 

Ekli dosyalar

Merhaba,

Ekteki dosyanıza gerekli uyarlamayı yaptım. İncelermisiniz.
 

Ekli dosyalar

hocam ellerinize sağlık şimdi ben bu kodu sayfa 1 deki yemek adı sutununa ama veri kaynağı olarak sayfa 2 deki yemek adı sutununu tanımlamaya çalışacağım yapamassam sizden yine yardım talep etsem ayıp etmiş olurmuyum saygılarımla
 
yaptım oldu ama birden fazla tekrarlanan veri olduğu için süzme yapabilirmiyim bilmiyorum bir araştıramam lazım bu koda süzme ekleye bilirmiyim yani userform da listelenen veriler süzüle bilirmi aynı olan verilerden sadece 1 tanesini listelemek mümkünmü
 
Merhaba,

Sayfaya ait koda kırmızı satırları ekleyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not UserForm1.ListBox1.Tag = "off" Then
If Intersect(Target, Range("C2:C" & Rows.Count)) Is Nothing Then Exit Sub
Dim deger As Range
sayac = 0
derlenen = Target.Address
bakilan = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
For Each deger In Sheets("VERİLER ").Range("B4:B" & Sheets("VERİLER ").Cells(Rows.Count, "B").End(3).Row)
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
[COLOR=red]If WorksheetFunction.CountIf(Sheets("VERİLER ").Range("B:B"), deger.Value) = 1 Then
[/COLOR]    sayac = sayac + 1
    sonuc = deger.Value
    
    If sayac = 1 Then
    UserForm1.ListBox1.Clear
    End If
    
    UserForm1.ListBox1.AddItem deger.Value
[COLOR=red]End If
[/COLOR]End If
Next
If sayac > 1 Then
UserForm1.Tag = derlenen
UserForm1.Caption = "Birden Cok Uygun Kayit Var, Lutfen Birini Seciniz"
UserForm1.ListBox1.Tag = "off"
UserForm1.Show
UserForm1.ListBox1.Tag = ""
ElseIf sayac = 1 Then
UserForm1.ListBox1.Tag = "off"
Range(derlenen) = sonuc
Else
UserForm1.ListBox1.Tag = "off"
bakilan = ""
sayac = 0
For Each deger In Sheets("VERİLER ").Range("B4:B" & Sheets("VERİLER ").Cells(Rows.Count, "B").End(3).Row)
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
    sayac = sayac + 1
    sonuc = deger.Value
    
    If sayac = 1 Then
    UserForm1.ListBox1.Clear
    End If
    
    UserForm1.ListBox1.AddItem deger.Value
End If
Next
UserForm1.Tag = derlenen
UserForm1.Caption = "Uygun Kayit Bulunamadi, Lutfen Listeden Birini Seciniz"
Range(derlenen) = ""
UserForm1.Show
End If
Else
UserForm1.ListBox1.Tag = ""
End If
End Sub
 
korhan hocam olmuş ama listede sadece benzersiz olanlar çıkıyor yani tek satırda kayıtlı olanlar örneğin çay ayran gibi ama yemek adı altında kayıtlı atıyorum sebzeli tavuk 4-5 defa tetrarlanmış bunu göstermiyor listede sadece tek satıra yazılmış olan veriler sıralanıyor birde bazan kod çaşımıyor mesele alt satırlara indikçe sanki çalışmada zorlanıyormuş gibi takılıyor... birde kodaki
End (3).row anlamı nedir saygılarımla
 
hocam yenilenenleri hallettim aynı sayfanın m sutununda daha önce formülle süzdüğüm bir veri kaynağı vardı onu hedef olarak tanımladım oldu ama hala vba kodu bazan çalışmıyor ben bir örnek örnek koyacağım bir sonraki msg de bakabilirmisinz bir yerde hata felanmı yapıyorum
 
hocam vaktini ayırdığınız için çok teşekkür ederim

örnek ekte
 

Ekli dosyalar

çok heveslendim valla bu kodlarla ve excelle neler yapabileceğimi düşündükçe içim içime sığmıyor gittikçe seviyorum ve sizlere minnetarım
 
userform sorunun buldum ama çözümü bilmiyorum form kod çalışınca çalışıyor ama sanırım sayfa sınırlarından taşıyor yani görünmüyor üst satırlarda sorun yok ama aşağılara indikçe user formun gösterildiği yer gittikçe açılıyor ve bir süre sonra kayboluyor çok ilginç. görünmüyor ama sanki görünüyor gibi alt ok tuşuna basıp enter diyince listeden herhangi bir şey seçilmiş gibi davranıyor çözüm öneriniz vardır mutlaka...
 
bunuda hallettim hehehe

Private Sub UserForm_Activate()
UserForm1.StartUpPosition = 3
UserForm1.Top = 90
UserForm1.Left = 350
End Sub

bu kodu user form içindeki kod sarına yazdım diğerini sildim oldu valla çalışıyor :))
 
şimdi userform dan seçim yapmadan esc ile çıkışıda yaptımmı tamamdır....
 
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
CommandButton1.Cancel = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then Cancel = True
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Range(UserForm1.Tag) = ListBox1.List(ListBox1.ListIndex)
UserForm1.Hide
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If ListBox1.ListIndex > -1 Then
Range(UserForm1.Tag) = ListBox1.List(ListBox1.ListIndex)
UserForm1.Hide
End If
End If
End Sub

Private Sub UserForm_Activate()
UserForm1.StartUpPosition = 3
UserForm1.Top = 90
UserForm1.Left = 350
End Sub

Bu kodu USERFORM altına yazdım oldu
 
Son düzenleme:
acil yardım

elimizde 100 veri var bunları excelde sınıflandırabilir miyiz ? yardım ederseniz çok sevinirim teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst