• DİKKAT

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

Tekrarlı verileri kaldırıp bir alana göre filtreleme

  • Konbuyu başlatan Konbuyu başlatan yi.94
  • Başlangıç tarihi Başlangıç tarihi
Katılım
30 Mart 2016
Mesajlar
9
Excel Vers. ve Dili
2010 ingilizce
Merhabalar. :yardim:
Bir öğretim üyesinin kitap adı, detayı, yayın yılı; makale adı, detayı, yayın yılı; proje adı; detayı; yayın yılı vb. şeklinde başlıklar bulunmakta. Bu başlıklar altında tekrarlayan veriler mevcut. Ben aynı yılda yazdığı makale, kitap yaptığı projeyi görmek istiyorum. Mesela bir kitap bir makale 3 proje olabilir. F sütununda kitabın yayın yılı; K sütununda makalenin yayın yılı; P sütununda projenin yapıldığı yıl var. A1:R29 alanı doludur. Örneğin kitap yayın yılına 2010 yazıldığında makaledeki 2010da yapılmış veride geliyor, proje olmadığı için boş geliyor. Fakat kitap yayın yılı 2010 harici bir şey yazıldığında tüm alanlar boş çıkıyor. Bunun sebebi nedir? Yazılan kodda mı bir hata var?
Yazılan kod şu şekildedir:

Sub deneme()
Dim p As Integer, k As Integer, i As Integer, n As Integer
Range("A1").Select
Set Matrix = Selection.CurrentRegion
k = InputBox("Kitabın yayın yılını giriniz.")
n = Matrix.Rows.Count
Sheets.Add After:=ActiveSheet
Sheets(1).Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A1").Select
ActiveSheet.Paste

p = 1
For i = 2 To n
Sheets(1).Select
If Matrix.Cells(i, 6).Value = k Then
Range("A1").Cells(i, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A2").Cells(p, 1).Select
ActiveSheet.Paste
p = p + 1
End If
Next i

Dim r As Integer, l As Integer, h As Integer, z As Integer
Range("A1").Select
Set Matrix = Selection.CurrentRegion
l = InputBox("Makalenin yayın yılını giriniz.")
z = Matrix.Rows.Count

r = 0
For h = 2 To n
If CInt(Matrix.Cells(h, 11).Value) = CInt(l) Then
Sheets(Sheets.Count).Select
Range("I2:M2").Offset(h - 2, 0).Select
Selection.Copy
Range("I2").Cells(r + 1, 1).Select
ActiveSheet.Paste
r = r + 1
End If
Next h
If r > 1 Then
Range("I2:M2").Offset(r, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ElseIf r = 1 Then
Range("I2:M2").Offset(r, 0).Select
Selection.Copy
Range("I2:M2").Select
ActiveSheet.Paste
Range("I2:M2").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ElseIf r = 0 Then
Range("I2:M2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End If

Dim q As Integer, m As Integer, j As Integer, t As Integer
Range("A1").Select
Set Matrix = Selection.CurrentRegion
m = InputBox("Projenin yayın yılını giriniz.")
t = Matrix.Rows.Count

q = 0
For j = 2 To n
If CInt(Matrix.Cells(j, 16).Value) = CInt(m) Then
Sheets(Sheets.Count).Select
Range("N2:R2").Offset(j - 2, 0).Select
Selection.Copy
Range("N2").Cells(q + 1, 1).Select
ActiveSheet.Paste
q = q + 1
End If
Next j
If q > 1 Then
Range("N2:R2").Offset(q, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ElseIf p = 1 Then
Range("N2:R2").Offset(q, 0).Select
Selection.Copy
Range("N2:R2").Select
ActiveSheet.Paste
Range("N2:R2").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ElseIf q = 0 Then
Range("N2:R2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End If

Range("A2:H2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$A$2:$H$100").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8), Header:=xlNo

Range("I2:M2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$I$2:$M$100").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlNo

Range("N2:R2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$N$2:$R$100").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlNo

Sheets(Sheets.Count).Select
Columns("A:A").ColumnWidth = 80
Columns("B:B").ColumnWidth = 80
Columns("C:C").ColumnWidth = 80
Columns("D:D").ColumnWidth = 80
Columns("E:E").ColumnWidth = 80
Columns("F:F").ColumnWidth = 80
Columns("G:G").ColumnWidth = 80
Columns("H:H").ColumnWidth = 80
Columns("I:I").ColumnWidth = 80
Columns("J:J").ColumnWidth = 80
Columns("K:K").ColumnWidth = 80
Columns("L:L").ColumnWidth = 80
Columns("M:M").ColumnWidth = 80
Columns("N:N").ColumnWidth = 80
Columns("O:O").ColumnWidth = 80
Columns("P:P").ColumnWidth = 80
Columns("R:R").ColumnWidth = 80
Columns("S:S").ColumnWidth = 80
Columns("T:T").ColumnWidth = 80
Columns("U:U").ColumnWidth = 80
Columns("V:V").ColumnWidth = 80
Columns("Y:Y").ColumnWidth = 80
Columns("Z:Z").ColumnWidth = 80
Range("A1").Select
Selection.CurrentRegion.Select
Selection.EntireColumn.AutoFit
Selection.EntireRow.AutoFit
Range("A1").Select

End Sub
 
Geri
Üst