Birden fazla koşulla hücre birleştirmek olmalı başlık.

[etalayhan]

selamlar, değerli arkadaşlar, ek'li dosyada olduğu gibi;
bir öğrenci birden fazla ders alıyor ve bunları ayrı satırlarda gösterdik "aldığı ders" başlığında.

acil olarak o kişinin aldığı ders listesini tek bir satırda göstermemiz gerek ve teker teker yapmak baya zamanımızı alacak. bu durumu kolaylaştıran bir formül var mıdır veya yardımcı olabilecek bir arkadaşımız?

link : http://s3.dosya.tc/server7/0b8i2p/deneme.xls.html

 

[Mertsan]

Sayın etalayhan ekli dosya görünmüyor?

 

[etalayhan]

malesef bulamadım dosya ekleme yerini değerli hocam

 

[etalayhan]

Sayın etalayhan ekli dosya görünmüyor?

http://s3.dosya.tc/server7/0b8i2p/deneme.xls.html

bu linkte örneği mevcut

 

[Necdet]

Merhaba,

Önce Burayı

Sonra; Dosya ekleyebilmeniz için Altın Üye olmanız gerekmektedir.

 

[Necdet]

Merhaba,

Önce Burayı okuyunuz

Sonra; Dosya ekleyebilmeniz için Altın Üye olmanız gerekmektedir.

 

[Mertsan]

Pivot Tablo eklemeyi denediniz mi?
Ekteki örneğe bakınız.
http://s3.dosya.tc/server7/p56pnl/deneme_Pivot.xls.html
http://s3.dosya.tc/server7/mgmyva/deneme_pv.JPG.html

 

[etalayhan]

üstadım malesef düz rapor şeklinde vermemiz gerek

 

[Ömer BARAN]

........o kişinin aldığı ders listesini tek bir satırda göstermemiz gerek ve teker teker yapmak baya zamanımızı alacak. bu durumu kolaylaştıran bir formül var mıdır veya yardımcı olabilecek bir arkadaşımız?....

Merhaba.
Aşağıdaki kod'u sayfanın kod bölümüne (alt taraftan sayfa adına fareyle sağ tıklayın,
açılan menüden KOD GÖRÜNTÜLEyi tıkladığınızda açılan ekranın sağ tarafındaki boş alana )
yapıştırın ve çalıştırın.
Kod'daki kırmızı kısım; birleştirme işlemi sonrası, ders bilgisi üste alınmış olan satırları siler.
Bunları silmek gerekmiyorsa kırmızı kısmı silebilirsiniz.

[FONT="Trebuchet MS"][B][COLOR="Blue"]Sub BİRLEŞTİR()[/COLOR][/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For satır = 2 To [A65536].End(3).Row
If WorksheetFunction.CountIf(Range("A1:A" & satır), Cells(satır, 1)) = 1 Then
baş = satır
son = baş + WorksheetFunction.CountIf(Range("A:A"), Cells(satır, 1)) - 1
    metin = Cells(satır, 5)
    For sat = baş + 1 To son
        metin = metin & "-" & Cells(sat, 5)
    Next
    Cells(satır, 5) = metin
End If
Next
[COLOR="Red"]For satt = 2 To [A65536].End(3).Row
baş = satt
son = baş + WorksheetFunction.CountIf(Range("A:A"), Cells(satt, 1)) - 1
If son > baş Then
    Rows(baş + 1 & ":" & son).Delete Shift:=xlUp
End If
Next[/COLOR]
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox " İŞLEM TAMAMLANDI "
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]

 

[cratos35]

bi gün bende kod yazmayı öğrenicem

 

[etalayhan]

ilgi ve alakanızdan dolayı teşekkür ediyorum