- Katılım
- 23 Ocak 2011
- Mesajlar
- 293
- Excel Vers. ve Dili
- 2007 excel
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Slm ,sayfa 2 de öğrenci isimlerine karşılık gelen öğretmenleri sayfa 1 e yazdırmak istiyorum.
Sub veriaktar()
Worksheets("Sayfa1").Columns("B:z").ClearContents
For r = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "a").Value
If Sheets("Sayfa1").Cells(r, "a").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A2:A" & r), aranan1) = 1 Then
sut = 2
For i = r To Worksheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row
aranan2 = Sheets("Sayfa2").Cells(i, "A").Value
If aranan2 = aranan1 Then
Sheets("Sayfa1").Cells(r, sut).Value = Sheets("Sayfa2").Cells(i, 2).Value
sut = sut + 1
End If
Next i
End If
End If
Next r
If WorksheetFunction.CountA(Sheets("Sayfa1").Cells) > 2 Then
sut2 = Sheets("Sayfa1").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Else
sut2 = 2
End If
For j = 2 To sut2
Sheets("Sayfa1").Cells(1, j).Value = "Öğretmen" & j - 1
Next j
MsgBox "işlem tamam"
End Sub
Teşekkür ederim. Ama formüllerle yapılabilirmi ...
Teşekkür ederim. Ama formüllerle yapılabilirmi ...
=EĞER(SÜTUNSAY($B2:B2)>EĞERSAY(Sayfa2!$A$2:$A$100;$A2);"";İNDİS(Sayfa2!$B$2:$B$100;KÜÇÜK(EĞER(Sayfa2!$A$2:$A$100=$A2;SATIR(Sayfa2!$A$2:$A$100)-SATIR(Sayfa2!$A$2)+1);SÜTUNSAY($B2:B2))))