• DİKKAT

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

Sayfa 1 den Sayfa2 ye veri almak

Slm ,sayfa 2 de öğrenci isimlerine karşılık gelen öğretmenleri sayfa 1 e yazdırmak istiyorum.

kod

Kod:
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 ...

Merhaba,

B2 hücresine yazıp dizi formülüne (ctrl + shift + enter tuş kombinasyonu ile )çevirdikten sonra yan ve alt hücrelere kopyalayın.

Kod:
=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))))

.
 
Geri
Üst