Bir sütunda boş olan hücreleri silme

[cems]

K sütununda 7000 satır veri dikine olarak bulunuyor ancak arada dağınık bulunan boş hücreler kopyala-tersine çevirerek yapıştır işleminde ( sütuna dizili bilgiyi satır satır yapabilmek isterken) hatalı çekim yaparak sorun çıkartıyor.

a) Sütunda boş hücreleri aşağıdaki kodla birleşmiş olarak nasıl sildirip
b) döngü halinde kopyala-özel tersine çevirerek yapıştır yapabiliriz ?

Sub Makro2()
Range("K1:K9").Select
Selection.Copy
Sheets("sayfa1").Select
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Range("K1:K9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

End Sub

 

[Orion1]

Buyurun.

Sub Makro2()
Range("K1:K9").SpecialCells(xlCellTypeConstants).Copy
Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
End Sub

 

[cems]

Sayın Orion1,
Müdahaleniz ve hızı için teşekkür ederim.
Kod sadece birinci kişi verisini aldı ve satır halinde yapıştırdı ama yürümedi. Sorunlar:
1- K Sütununda veri aralarında düzensiz bulunan boş hücreleri dikey durumdaki veri sonuna kadar silmek ve
2- dikey 7000 kişilik veriyi döngü olarak yatay hale çevirmek

boş hücreler silindiğinde her aday için kullanılan dikey hücre sayısı eşitleşiyor ve döngü yapılabilirse sonuna kadar hatasız dizgi yapabilir.

Ancak bunları kuramıyorum, desteğe devamınız sabaha kadar oturmamı engelleyecek

 

[Orion1]

1- benim yazdığım kod döngüden çok hızlı çalışır.
2-7000 satırdaki veriyi sütuna tranpose ederseniz,2007de bilmiyorum ama 2003 te sütun sayısı 256 sütundur.Bu durumu göz önünde bulundurunuz.
yazdığım kod aradaki boş hücreleri atlayıp sadece dolu hücreleri a1 hücresine transpose edip yapıştırıyor.

Sayın Orion,
Müdahaleniz ve hızı için teşekkür ederim.
Kod sadece birinci kişi verisini aldı ve satır halinde yapıştırdı ama yürümedi. Sorunlar:
1- K Sütununda veri aralarında düzensiz bulunan boş hücreleri dikey durumdaki veri sonuna kadar silmek ve
2- dikey 7000 kişilik veriyi döngü olarak yatay hale çevirmek

boş hücreler silindiğinde her aday için kullanılan dikey hücre sayısı eşitleşiyor ve döngü yapılabilirse sonuna kadar hatasız dizgi yapabilir.

Ancak bunları kuramıyorum, desteğe devamınız sabaha kadar oturmamı engelleyecek

 

[cems]

Sayın Orion1;
Tek kişinin verisi soldan sağa 9 hücreye sığıyor. Sorun bütün adayların bütün bilgileri aşağı doğru sıralanmış durumda. Sizin kodlarınız ışığında şunu yaptım :

Sub Makro2()
Sheets("sayfa1").Select
Range("K1").Select
If Range("K1") = "" Then
Selection.Delete Shift:=xlUp

ElseRange("K1:K9").SpecialCells(xlCellTypeConstants).Copy
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Range("K1:K9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If


Bu şekilde elle Vba da Run edince çalışıyor ve K sütunundaki dikine 9 veriyi A-I arasına ve
sürekli bir alta kaydediyor. Kullanılmış veriyi de silerek sütunu yukarı çekiyor.
Bunu döngüleştirmek ne kadar mümkün ?
End Sub

 

[Orion1]

Niye bunları yaptınız ki ben 2nci mesajda verdim cevabı.
Silmeden tarnspose boşlukları almayarak yapıyor.
Ayrıca 7000 verniz için bir şey hatırlattım size.Onu kaale aldınızmı?

Sayın Orion1;
Tek kişinin verisi soldan sağa 9 hücreye sığıyor. Sorun bütün adayların bütün bilgileri aşağı doğru sıralanmış durumda. Sizin kodlarınız ışığında şunu yaptım :

Sub Makro2()
Sheets("sayfa1").Select
Range("K1").Select
If Range("K1") = "" Then
Selection.Delete Shift:=xlUp

ElseRange("K1:K9").SpecialCells(xlCellTypeConstants).Copy
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=True
Range("K1:K9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If


Bu şekilde elle Vba da Run edince çalışıyor ve K sütunundaki dikine 9 veriyi A-I arasına ve
sürekli bir alta kaydediyor.
Bunu döngüleştirmek ne kadar mümkün ?
End Sub

 

[cems]

Sayın Orion1;
Evet, ancak ekteki örnek dosyadaki gibi , ilk kişinin verisini alıyor ve duruyor.

 

[Orion1]

Buyurunuz.

Sub Makro2()
Dim sat As Long, liste(), i As Long
sat = Cells(Rows.Count, "K").End(xlUp).Row
liste = Range("K1:K" & sat).Value
Application.ScreenUpdating = False
For i = 1 To UBound(liste)
    If liste(i, 1) <> "" Then
        sut = sut + 1
        Cells(1, sut).Value = liste(i, 1)
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[cems]

Sayın Orion1;
Belki ben hatalı izah ettim , özür dilerim . Kodlarınız çok hızlı çalıştı ama sağa doğru adaylar yanyana dizildi:
Tam yapmak istediğim database gibi her aday için 1 satırda 9 hücre kullanarak döngü yapabilmek ve aday bilgilerini satırlarda altalta dizmek , bunu yaparken arada boş hücrelerin sorun çıkarmaması için baştan silmek

 

[Orion1]

Sayın Orion1;
Belki ben hatalı izah ettim , özür dilerim . Kodlarınız çok hızlı çalıştı ama sağa doğru adaylar yanyana dizildi:
Tam yapmak istediğim database gibi her aday için 1 satırda 9 hücre kullanarak döngü yapabilmek ve aday bilgilerini satırlarda altalta dizmek , bunu yaparken arada boş hücrelerin sorun çıkarmaması için baştan silmek

Siz elle bir kaç tane yapın göreyim.Böyle anlaşılmıyor.

 

[cems]

Sayın Orion1;
Dikey verinin yanındaki tuşa kodu yükledim. Diğer kodlar Modullerde

 

[cems]

Döngü yapabilir miyiz ?