Yanyana sütunlardaki Verileri Tek Bir Satırda Nasıl Birleştiririz..Acil Yardım lütfen

[smile80]

Merhabalar... Bir dersanede çalışıyorum.. ekte sunmuş olduğum excell dosyasında ögrencilerin almış olduğu sınav sonusları var. Bunlar Ders Adı. Dogru (D) Yanlış (Y) olarak yan yana sütunlarda birleştirdim. Ancak bunları sms ile gondereceğim için tek bir satırda birleştirmem lazım...Yardımcı olursanız çok sevinirim.. Saygılarımla..

 

[usubaykan]

Merhabalar... Bir dersanede çalışıyorum.. ekte sunmuş olduğum excell dosyasında ögrencilerin almış olduğu sınav sonusları var. Bunlar Ders Adı. Dogru (D) Yanlış (Y) olarak yan yana sütunlarda birleştirdim. Ancak bunları sms ile gondereceğim için tek bir satırda birleştirmem lazım...Yardımcı olursanız çok sevinirim.. Saygılarımla..

Merhaba;

Kullanılan kod

Option Explicit

Sub deneme()
Dim u As Byte, hücre
    Range("A2") = ""
    For u = 1 To Range("IV1").End(1).Column
        If Cells(1, u) <> "" Then
            hücre = Range("A2")
            If hücre = "" Then
                Range("A2") = hücre & Cells(1, u)
                Else
                Range("A2") = hücre & " " & Cells(1, u)
            End If
        End If
    Next
End Sub

 

[smile80]

Hocam teşekkür ederim.... ellerine saglık..yalnız örnek verdiğim satırdan 50- 100 tane ögrenci bilgileri alt alta olacak demeyi unuttum..
verdiğiniz kodu sayfa2 de alt alta alacak sekilde yapabilirmisiniz...

 

[smile80]

Hocam ordamısınız... Acaba bu kodu 100 ögrenci icin baska sayfaya aktararak yapmama yardımcı olumusunuz... Teşekkürler

 

[usubaykan]

Hocam ordamısınız... Acaba bu kodu 100 ögrenci icin baska sayfaya aktararak yapmama yardımcı olumusunuz... Teşekkürler

Merhaba;

Kullanılan kod

Option Explicit

Sub Deneme()
Dim U As Byte, S As Long, hücre As String, S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
S2.Range("A:A") = ""
    For S = 1 To S1.Range("A65536").End(3).Row
        For U = 1 To S1.Range("IV1").End(1).Column
            If S1.Cells(1, U) <> "" Then
                hücre = S2.Cells(S, "A")
                If hücre = "" Then
                    S2.Cells(S, "A") = hücre & S1.Cells(S, U)
                    Else
                    S2.Cells(S, "A") = hücre & " " & S1.Cells(S, U)
                End If
            End If
        Next
    Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "Sn: " & Application.UserName
Application.ScreenUpdating = True
End Sub

 

[smile80]

Cok ama cok teşekkür ederim hocam... beni büyük bir dertten kurtardınız... İyi akşamlar..

 

[usubaykan]

Cok ama cok teşekkür ederim hocam... beni büyük bir dertten kurtardınız... İyi akşamlar..

Rica ederim sizede iyi akşamlar