dolu satırları ve sütunları tek sütuna aktarmak

E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Değerli Üyeler,
Tablo şeklinde düzenlenmiş Bir aylık ders programında her gün 08.30, 09.30, 10.30 ve 11.30 da olmak üzere 4 ders var. Ders programı Türkçe Öğretmeni ALİ ye ait.

Yapmak istediğim;
ALT ALT a sayfasına, her gün dolu olan dersleri tek sütun olacak şekilde alt alta aktarmak

Ayrıntılı açıklama dosyadadır.

Yardımlarınız için şimdiden teşekkürler!!!
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Byte, Y As Long
    Dim Satır As Long
    Set S1 = Sheets("ALİ")
    Set S2 = Sheets("ALT ALTA")
    S1.Select
    Satır = 7
    S2.[C7:H65536].Clear
    For X = 2 To 5
    For Y = 7 To [A65536].End(3).Row
    If Cells(Y, X) <> "" Then
    Cells(Y, 1).Copy S2.Cells(Sat&#305;r, 3)
    Cells(6, X).Copy S2.Cells(Sat&#305;r, 4)
    Cells(Y, X).Copy S2.Cells(Sat&#305;r, 5)
    If Left(UCase(Cells(Y, X)), 5) = "ORTAK" Then
    S2.Cells(Sat&#305;r, 6) = "&#199;&#304;FT"
    Else
    S2.Cells(Sat&#305;r, 6) = "TEK"
    End If
    S2.Cells(Sat&#305;r, 7) = S1.[B1]
    S2.Cells(Sat&#305;r, 8) = S1.[B2] & " DERS&#304;"
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    Next
    With S2.Range("C6:H" & S2.[C65536].End(3).Row)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
 
    With S2.Range("C6:H" & S2.[C65536].End(3).Row)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub
 
[COLOR=blue]'KULLANILAN KODUN A&#199;IKLAMALARI
'1.SATIR - Makromuza AKTAR ismini veriyoruz.
'2-3-4.SATIR - Kod yazarken kullanaca&#287;&#305;m&#305;z k&#305;saltmalar&#305; tan&#305;ml&#305;yoruz. S1 ve S2 k&#305;saltmalar&#305;n&#305; sayfa olarak tan&#305;ml&#305;yoruz. X-Y ve Sat&#305;r k&#305;saltmalar&#305;n&#305; ise Long olarak tan&#305;ml&#305;yoruz.
'5-6.SATIR - S1 ve S2 k&#305;saltmalar&#305;n&#305; tan&#305;mlay&#305;p haf&#305;zaya al&#305;yoruz.
'7.SATIR - S1 isimli sayfay&#305; se&#231;iyoruz.
'8.SATIR - Sat&#305;r de&#287;i&#351;kenini 7 de&#287;erine e&#351;itliyoruz.
'9.SATIR - S2 isimli sayfadaki veri aktar&#305;lacak alan&#305; temizliyoruz.
'10.SATIR - X ad&#305;nda S1 isimli sayfadaki s&#252;tunlar&#305; ifade eden bir d&#246;ng&#252; ba&#351;lat&#305;yoruz.
'11.SATIR - Y ad&#305;nda S1 isimli sayfadaki sat&#305;rlar&#305; ifade eden bir d&#246;ng&#252; ba&#351;lat&#305;yoruz.
'12.SATIR - Aktaraca&#287;&#305;m&#305;z h&#252;crenin bo&#351; olup olmad&#305;&#287;&#305;n&#305; sorguluyoruz.
'13-14-15.SATIR - Ko&#351;ulumuz sa&#287;lan&#305;yorsa ilgili h&#252;creleri S2 isimli sayfaya kopyal&#305;yoruz.
'16-17-18-19-20.SATIR - Sorgulad&#305;&#287;&#305;m&#305;z h&#252;crenin ilk be&#351; karakteri ORTAK ise S2 sayfas&#305;na ilgili h&#252;creye &#199;&#304;FT de&#287;ilse TEK yazd&#305;r&#305;yoruz.
'21-22.SATIR - &#214;&#287;retmen ve Ders ad&#305;n&#305; S2 sayfas&#305;nda ilgili h&#252;crelere aktar&#305;yoruz.
'23.SATIR - Sonraki h&#252;crelerin aktar&#305;m&#305;nda verileri &#252;st &#252;ste aktarmamas&#305; i&#231;in Sat&#305;r de&#287;i&#351;kenini bir artt&#305;r&#305;yoruz.
'24.SATIR - 12. sat&#305;rdaki sorgumuzu sonland&#305;r&#305;yoruz.
'25.SATIR - Y isimli d&#246;ng&#252;ye devam ediyoruz.
'26.SATIR - X isimli d&#246;ng&#252;ye devam ediyoruz.
'27-51.SATIRLAR - S2 isimli sayfada olu&#351;an tabloya kenarl&#305;k &#231;izdiren kodlard&#305;r.
'52-53.SATIR - Haf&#305;zaya ald&#305;&#287;&#305;m&#305;z sayfa isimlerini haf&#305;zadan siliyoruz.
'54.SATIR - Kullan&#305;c&#305;ya i&#351;lemin tamamland&#305;&#287;&#305;na dair uyar&#305; mesaj&#305; veriyoruz.
'55.SATIR - Makromuzu sonland&#305;r&#305;yoruz.[/COLOR]
 
Son düzenleme:
E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Say&#305;n Korhan AYHAN,
Size ger&#231;ekten nas&#305;l te&#351;ekk&#252;r edece&#287;imi bilemiyorum. Sizlerden cevaplar ve &#231;&#246;z&#252;m yollar&#305; geldik&#231;e excelin s&#305;n&#305;rlar&#305;n&#305;n ne kadar geni&#351; oldu&#287;unu daha iyi anl&#305;yorum.

Say&#305;n AYHAN,
Forumun kurallar&#305;na &#231;ok uygun olmad&#305;&#287;&#305;n&#305; biliyorum ama sizden bir &#351;ey rica edebilir miyim?

Benim "Ders Da&#287;&#305;l&#305;m&#305;" ba&#351;l&#305;&#287;&#305; ile a&#231;t&#305;&#287;&#305;m bir konum var. (&#350;u andaki sizin &#231;&#246;zd&#252;&#287;&#252;n&#252;z ders program&#305; &#231;izelgesinin olu&#351;turulmas&#305; ile ilgili bir konu.) O konuya bakabilir misiniz? Sadece merak etti&#287;im excel ile bunun m&#252;mk&#252;n olup olmad&#305;&#287;&#305;. E&#287;er m&#252;mk&#252;n de&#287;ilse, bunu &#246;&#287;renmem bile bana b&#252;y&#252;k bir yard&#305;m olacakt&#305;r.

Ay&#305;ca, &#351;u anda yazd&#305;&#287;&#305;n&#305;z kodlar&#305; &#231;&#246;zmeye &#231;al&#305;&#351;aca&#287;&#305;m ama zaman&#305;n&#305;z uygun olunca kodlar&#305;n k&#305;sa k&#305;sa a&#231;&#305;klamalar&#305;n&#305; yazabilirseniz &#231;ok memnun olurum. &#199;&#252;nk&#252; oradan hareketle kendimi geli&#351;tirebilece&#287;ime inan&#305;yorum.

Her &#351;ey i&#231;in &#351;imdiden te&#351;ekk&#252;rler!!!
 
E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Dolu Satırları sütun olarak aktarma

Sayın Korhan AYHAN,
Hazırlamış olduğunuz kodları kullanarak satır ve sütunların adreslerinde değişiklik yapmak istedim. Ancak, "ORTAK" olunca "ÇİFT" değilse "TEK" yazsın satırını düzeltemedim.

Benim anladığım kadarıyla sizin kodlarınızdaki;

Cells(Y, 1).Copy S2.Cells(Satır, 3)
Cells(6, X).Copy S2.Cells(Satır, 4)
Cells(Y, X).Copy S2.Cells(Satır, 5)
If Left(UCase(Cells(Y, X)), 5) = "ORTAK" Then
S2.Cells(Satır, 6) = "ÇİFT"
Else
S2.Cells(Satır, 6) = "TEK"

satırlarda değişiklik yaparak şu şekilde düzenledim. Ancak "TEK" olarak yazmasına rağmen "ORTAK" olan satırlarda "ÇİFT" yazmıyor. Acaba nerede hata yapıyorum.

Cells(Y, 1).Copy S2.Cells(Satır, 30)
Cells(6, X).Copy S2.Cells(Satır, 31)
Cells(Y, X).Copy S2.Cells(Satır, 29)
If Left(UCase(Cells(Y, X)), 29) = "ORTAK" Then
S2.Cells(Satır, 32) = "ÇİFT"
Else
S2.Cells(Satır, 32) = "TEK"

Yardımlarınız için şimdiden çok teşekkürler!!!
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Hatan&#305;z a&#351;a&#287;&#305;daki k&#305;s&#305;mda;

K&#305;rm&#305;z&#305; renkli b&#246;l&#252;me 5 yazarak deneyiniz.

Kod: 
If Left(UCase(Cells(Y, X)), [COLOR=red][B]29[/B][/COLOR]) = "ORTAK" Then
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Ayr&#305;ca kodla istedi&#287;iniz k&#305;sa a&#231;&#305;klamalar&#305; 2. mesaj&#305;mdaki kodu alt&#305;na mavi renkle ekledim. Umar&#305;m faydas&#305; olur.
 
E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Say&#305;n Korhan AYHAN,
Size &#231;ok &#231;ok te&#351;ekk&#252;r ederim. Her &#351;ey i&#231;in &#231;ok sa&#287;olun!!!
 
E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Say&#305;n Korhan AYHAN,

'16-17-18-19-20.SATIR - Sorgulad&#305;&#287;&#305;m&#305;z h&#252;crenin ilk be&#351; karakteri ORTAK ise S2 sayfas&#305;na ilgili h&#252;creye &#199;&#304;FT de&#287;ilse TEK yazd&#305;r&#305;yoruz.

A&#231;&#305;klamalardaki ilgili sat&#305;rlardan anlad&#305;&#287;&#305;m; "sorgulad&#305;&#287;&#305;m&#305;z h&#252;cre, Y ve X in &#231;ak&#305;&#351;t&#305;&#287;&#305; h&#252;cre."

If Left(UCase(Cells(Y, X)), 5) = "ORTAK" Then

Ancak, kodlarda baz&#305; de&#287;i&#351;iklikler yaparak yine ayn&#305; h&#252;creyi sorgulayarak ayn&#305; i&#351;lemi yapmak istiyorum ama sonu&#231; alam&#305;yorum. Acaba nerede yanl&#305;&#351; yap&#305;yorum?

For X = 2 To 52
For Y = 7 To [A65536].End(3).Row
If Cells(Y, X) <> "" Then
Cells(Y, 1).Copy S2.Cells(Sat&#305;r, 4)
Cells(6, X).Copy S2.Cells(Sat&#305;r, 5)
Cells(3, X).Copy S2.Cells(Sat&#305;r, 7)
Cells(4, X).Copy S2.Cells(Sat&#305;r, 8)

Cells(Y, X).Copy S2.Cells(Sat&#305;r, 3)
If Left(UCase(Cells(Y, X)), 5) = "ORTAK" Then
S2.Cells(Sat&#305;r, 6) = "GRUP"
Else
S2.Cells(Sat&#305;r, 6) = "B&#304;REYSEL"
Sat&#305;r = Sat&#305;r + 1

End If
'S2.Cells(Sat&#305;r, 7) = S1.[B1]
'S2.Cells(Sat&#305;r, 8) = S1.[B2] & " DERS&#304;"
'Sat&#305;r = Sat&#305;r + 1
End If
Next
Next
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Tam olarak ne yapmak istiyorsunuz?
 
E

Erdinç FIRTINA

Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
12-10-2023
Say&#305;n Korhan AYHAN,
Size &#231;ok &#231;ok te&#351;ekk&#252;r ederim. Hemen hemen b&#252;t&#252;n sorular&#305;mla ve dosyalar&#305;mla ilgilendiniz. &#350;u anda siz de&#287;erli insanlardan yararlanarak yapmaya &#231;al&#305;&#351;t&#305;&#287;&#305;m dosyam &#252;zerinde &#231;al&#305;&#351;&#305;yorum. Yukar&#305;daki sorunumu da &#231;&#246;zd&#252;m say&#305;l&#305;r&#305;m. Ama dosyamda yol katettikten sonra da size g&#246;nderip ele&#351;tirilerinizi almak isterim. &#304;nan&#305;n ki sizlerden gelen kodlarla epey yol kat etti&#287;imi d&#252;&#351;&#252;n&#252;yorum. Ama &#246;ncelikle sizlerin kodlar&#305;ndan hareketle de bir &#351;eyleri kendim yapmak istiyorum. Ancak &#246;yle ilerleyebilirim. (Tabi ki &#246;&#287;renmeye 45 inden sonra merak olunca biraz yava&#351; oluyor. &#304;yi ki sizler gibi sab&#305;rl&#305; insanlar var.)

Sizlere ve yard&#305;mlar&#305; olan herkese &#231;ok te&#351;ekk&#252;r ederim!!!
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst