Dinamik alanlı açılan liste ve veri sıralama

[alooo]

Arkadaşlar,
bu hususta 2 farklı sorum olacaktır.

1: Farklı sayfadaki (sayfa1) sütundaki verileri Sayfa2'de belirtilen aralığa yerleştirilerek mükerrer kayıtlardan 1 tane kalacak şekilde sıraladıktan sonra istenilen sütunlara sıralama sayısına göre bölümler açarak ilgili içeriği bu bölümler altına sıralayacak bir makro yapılabilir mi?

2: Veri doğrulama ile her ad tanımlaması doğru çalışırken, boşluklar gözükmesin diye formül ile oluşturduğumuz adların, koşullu hücre ile açılması istenildiğinde açılmamasıdır.

Konuya ilişkin (daha açıklayıcı bilgiler içeren) örnek dosya aşağıdaki linkte olup, yardım ederseniz sevinirim.

http://www.dosyaupload.com/dfPS

Saygılar,

 

[alooo]

Arkadaşlar,
Onca zaman geçmesine rağmen cevap gelmeyince ben kendi çabalarımla konuyu hallettim ve çözdüm. Mutlak suretle belki bunun daha kestirme yöntemi mevcuttur ama elimden gelen bu

Belki başka arkadaşlara da lazım olur diye paylaşıyorum. umarım işinizi görür.

Link : http://www.dosyaupload.com/hseM

Dosya silinirse diye SORU 1 kodu:

Sub veriat()
'
' Makro1 Makro
'

' Verileri Sayfa1'den Al
Sheets("Sayfa1").Select
Columns("y:z").Select
Selection.Copy
Sheets("Cevap").Select
Range("p1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Verileri Ayrıştırmaya başla
Dim sa As Worksheet, se As Worksheet
Set sa = Sheets("Cevap")


'BANKA
sa.Range("t3:t100").ClearContents 'hedefi Temizle
Application.ScreenUpdating = False
For i = 1 To sa.Range("p65536").End(3).Row 'kontrol sutunu
If sa.Cells(i, "p") = "Banka" Then 'kontrol sutununda ne arayacağı
Son = sa.Range("t65536").End(3).Row + 1 'hedefe bak
sa.Range("q" & i).Copy sa.Cells(Son, "t") 'istenileni bul, hedefe yaz
End If
Next i
Application.ScreenUpdating = True
' Sırala
Range("t3:t100").Select
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Add Key:=Range( _
"t3:t100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Cevap").Sort
.SetRange Range("t2:t100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$t$3:$t$100").RemoveDuplicates Columns:=1, Header:=xlYes 'Benzerleri Sil
'BANKA SONU
'Firma
sa.Range("u3:u100").ClearContents 'hedefi Temizle
Application.ScreenUpdating = False
For i = 1 To sa.Range("p65536").End(3).Row 'kontrol sutunu
If sa.Cells(i, "p") = "Firma" Then 'kontrol sutununda ne arayacağı
Son = sa.Range("u65536").End(3).Row + 1 'hedefe bak
sa.Range("q" & i).Copy sa.Cells(Son, "u") 'istenileni bul, hedefe yaz
End If
Next i
Application.ScreenUpdating = True

' Sırala
Range("u3:u100").Select
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Add Key:=Range( _
"u3:u100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Cevap").Sort
.SetRange Range("u2:u100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$u$3:$u$100").RemoveDuplicates Columns:=1, Header:=xlYes 'Benzerleri Sil
'FİRMA SONU
'KRedi KArtı
sa.Range("v3:v100").ClearContents 'hedefi Temizle
Application.ScreenUpdating = False
For i = 1 To sa.Range("p65536").End(3).Row 'kontrol sutunu
If sa.Cells(i, "p") = "Kredi_Kartı" Then 'kontrol sutununda ne arayacağı
Son = sa.Range("v65536").End(3).Row + 1 'hedefe bak
sa.Range("q" & i).Copy sa.Cells(Son, "v") 'istenileni bul, hedefe yaz
End If
Next i
Application.ScreenUpdating = True

'Sırala
Range("v3:v100").Select
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Add Key:=Range( _
"v3:v100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Cevap").Sort
.SetRange Range("v2:v100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$v$3:$v$100").RemoveDuplicates Columns:=1, Header:=xlYes 'Benzerleri Sil
'Kredi KArtı SONU
'PErsonel
sa.Range("w3:w100").ClearContents 'hedefi Temizle
Application.ScreenUpdating = False
For i = 1 To sa.Range("p65536").End(3).Row 'kontrol sutunu
If sa.Cells(i, "p") = "Personel" Then 'kontrol sutununda ne arayacağı
Son = sa.Range("w65536").End(3).Row + 1 'hedefe bak
sa.Range("q" & i).Copy sa.Cells(Son, "w") 'istenileni bul, hedefe yaz
End If
Next i
Application.ScreenUpdating = True

'Sırala
Range("w3:w100").Select
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Add Key:=Range( _
"w3:w100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Cevap").Sort
.SetRange Range("w2:w100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$w$3:$w$100").RemoveDuplicates Columns:=1, Header:=xlYes 'Benzerleri Sil
'Personel SONU
'TAşeron
sa.Range("x3:x100").ClearContents 'hedefi Temizle
Application.ScreenUpdating = False
For i = 1 To sa.Range("p65536").End(3).Row 'kontrol sutunu
If sa.Cells(i, "p") = "Taşeron" Then 'kontrol sutununda ne arayacağı
Son = sa.Range("x65536").End(3).Row + 1 'hedefe bak
sa.Range("q" & i).Copy sa.Cells(Son, "x") 'istenileni bul, hedefe yaz
End If
Next i
Application.ScreenUpdating = True

'Sırala
Range("x3:x100").Select
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Cevap").Sort.SortFields.Add Key:=Range( _
"x3:x100"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Cevap").Sort
.SetRange Range("x2:x100")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$x$3:$x$100").RemoveDuplicates Columns:=1, Header:=xlYes 'Benzerleri Sil
'Taşeron SONU
Range("p1").Select

End Sub

SORU 2 Cevabı:
ad tanımlaması yaparken boş hücrelerin gözükmemesi için

=KAYDIR(Cevap!$T$3:$T$100;0;0;BAĞ_DEĞ_DOLU_SAY(Cevap!$T$3:$T$100);1)

kodu kullanıldıktan sonra yapılan ana başlıkları görüntüleyecek hücreye veri tanımı yaptım. Alt başlıkların görüleceği satıra veri doğrulama yapılırken

=EĞER(G3="Banka";Banka;EĞER(G3="Firma";Firma;EĞER(G3="Kredi_Kartı";Kredi_Kartı;EĞER(G3="Personel";Personel;EĞER(G3="Taşeron";Taşeron;"")))))

kod ile bağlantı kurdum.