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
").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
").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
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
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
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
