Cevaplara satır ekleyip kişi bazlı tek satırda cevapları gösterme

[seiko_006]

Arkadaşlar,

Başımda bir iş var, bir türlü çözemedim.

elimde, 3 sütün ve yaklaşık 200 bin satırdan oluşan bir tablo var.

1. sütun kişi
2. sütun soru
3. sütun cevap

burada yapmak istediğim 3. sütunda bulunan bir cevap olan "Katılıyorum" cevaplarının altına bir boş sütun ekleyip bu boş sütunu da "Katılıyorum" diyen kullanıcının bir boş cevabı olarak görmesi ve bunları böyle sayfa 2 ye her kişi için tek satırda sütun sütun cevapların gelmesi. Bu konuyu benim için çok önemli. Bana yardım ederseniz çok sevinirim.

Örnek dosya ektedir.

 

[apocalyt]

bir modüle kopyalayıp çalıştırın..


Sub daylight()
Application.ScreenUpdating = False
Sheets(2).Range("a2:hz50000").ClearContents
For x = 2 To Sheets(1).[a500000].End(3).Row
For y = x + 1 To Sheets(1).[a500000].End(3).Row
If Sheets(1).Cells(x, 1) = Sheets(1).Cells(y, 1) Then
a = a + 1
Else
GoTo gel
End If
Next y
gel:
Sheets(1).Cells(x, 1).Copy
Sheets(2).Cells(Sheets(2).[a500000].End(3).Row + 1, 1).PasteSpecial
Sheets(1).Range("c" & x & ":c" & x + a).Copy
Sheets(2).Cells(Sheets(2).[b500000].End(3).Row + 1, 2).PasteSpecial Transpose:=True
x = x + a
a = 0
Next x
For ben = 2 To Sheets(2).[a500000].End(3).Row
For sen = 2 To Cells(ben, 220).End(xlToLeft).Column + 30
If Sheets(2).Cells(ben, sen) = "Katılıyorum" Then
Sheets(2).Cells(ben, sen + 1).Insert shift:=xlToRight
End If
Next sen
Next ben
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub

 

[seiko_006]

hata

Sheets(2).Range("a2:hz50000").ClearContents
satırında hata veriyor. yardımcı olabilir misizinz

 

[apocalyt]

sn seiko ben kodu tekrar denedim hata vermiyor..siz hatalı dosyayı yükleyin bakayım..

 

[seiko_006]

Katılıyorumdan sonra boş hücre eklemiyor

hocam kod çalışıyor ancak ekleme yaparken katılıyorum cevabından sonra bir boş hücre ekleme işlemi yapmıyor.

 

[apocalyt]

sn seiko..ben kodu süreklü olarak 2 inci sayfada denedim..ve hep istediğim sonucu almıştım..şimdi sizin birinci sayfaya koyduğunuz düğme üzerinden deneyince dediğiniz gibi "ktılıyorumdan" sonra boş hücre eklemiyor..ben yukarıda ki kodda gerekli ilaveyi yaptım..şimdi istediğiniz gibi düğmenize atayıp çalıştırabilirsiniz..doğru sonucu verecektir.

 

[seiko_006]

Katkılarınızdan dolayı çok teşekkür ederim.