verileri sırayla yazmak

[mersilen]

arkadaşlar
tablo 1 deki verileri tablo 2 ye sırayla / (sırasızda olabilir) aradaki boşlukları kaldırarak yazacak kod lazım
tşk

 

[Orion1]

Dosyanız ektedir.

Sub Sirali_yaz_59()
Dim i As Byte, k As Byte, sat As Byte, sut As Byte
Sheets("Sayfa2").Select
Range("A12:K16").ClearContents
sat = 12
For i = 2 To 6
    sut = 1
    For k = 1 To 11
        If Cells(i, k).Value <> "" Then
            Cells(sat, sut).Value = Cells(i, k).Value
            sut = sut + 1
        End If
    Next
    sat = sat + 1
Next i
MsgBox "İşlem tamamlandı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[mersilen]

evren bey
tşk ederim

 

[Orion1]

enver bey
tşk ederim

Bişey değil.
Not:İsmim enver değil.Evren.

 

[mersilen]

pardon evren hoca ismini düzelttim

tabloda biraz geliştirme yapabilir miyiz?
tablo 3 ekledim,

tablo 1 de yine isimler var
tablo 2 de sizin kodla tablo 1 deki boşlukları alıp yan yana yazıyoruz
tablo 3 de veri doğrulama listesi var, kaynak tablo 2
..........tabloya veri girdikçe tablo 1 den kendini siliyor,yeni boş hücre çıkıyor
..........veri doğrulama listesinde aralarda boşluklar oluşuyor
..........sizin kodu tablo 3 e veri doğrulama ile her veri girişinde otomatik çalıştırabilirsek ; veri doğrulama listesi güncelleneceğinden, liste içinde aralı boşluklar olmayacak, listedeki veriler yukarıda - boşluklar aşağıda toplanacak.

buda veri girişini kolaylaştıracak
alternatif fikirlerde değerlendirilir tabi ki !

 

[Orion1]

Dosyanız ektedir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A25:K29]) Is Nothing Then Exit Sub
On Error Resume Next
Sirali_yaz_59
End Sub

 

[mersilen]

evren bey
yine mükemmel çözüm , çok sağolasın

bir sorum daha olabilir mi?
tablo 3 deki hücrelere veri girişi yaparken , veri doğrulama listesi açılınca kaydırma çubuğu neden alt seviyelerde bir yeri gösteriyor olabilir? Listeyi yukarıdan aşağıyı gösterecek şekilde açılması sağlamanın bir yolu var mı?

 

[Orion1]

evren bey
yine mükemmel çözüm , çok sağolasın

bir sorum daha olabilir mi?
tablo 3 deki hücrelere veri girişi yaparken , veri doğrulama listesi açılınca kaydırma çubuğu neden alt seviyelerde bir yeri gösteriyor olabilir? Listeyi yukarıdan aşağıyı gösterecek şekilde açılması sağlamanın bir yolu var mı?

Göstermiyor.
Mesela D25 hücresini ele alalım.
Refrans veri doğrulamanız.
=$A12:$K12
Bu durumda listede ilk sırada A12 hücresinedeki veri sonradaki sıralardada B12,C12 ... gibi olmalıdır.
Sizin listenizinde ilk sırasında A12 deki değer var yani a12 hücresindeki değer d
Siizn listenizdeki ilk sıradaki değerde d .Bu durmda doğru gösteriyor.Yanlış göstermiyor.

 

[mersilen]

evren hocam
listenin başındaki ilk hücre boş olursa dediğim oluyor gibi
tablo 2 deki ilk hücrenin içini silnce dediğim oluyor
bu mantıkla veri doğrulamanın başına (mesela a24 boş hücresini) bir hücre ekleyebilirsem olacak gibi

=($A$24;$A12:$K12)
ama sistem buna izin vermedi

 

[mersilen]

evren bey
tablonun başına bir boş sütun ekleyerek yaptım
=$A12:$M12 ( a12 boş hüce yaptım)
veri doğrulama listesi düzgün çalışıyor

veri doğrulama listesini =($A$24;$A12:$K12) ile çözebilseydik daha güzel olacaktı (a24 boş hücre)
bunu yapmak mümkün mü?

 

[Orion1]

evren bey
tablonun başına bir boş sütun ekleyerek yaptım
=$A12:$M12 ( a12 boş hüce yaptım)
veri doğrulama listesi düzgün çalışıyor

veri doğrulama listesini =($A$24;$A12:$K12) ile çözebilseydik daha güzel olacaktı (a24 boş hücre)
bunu yapmak mümkün mü?

O şekilde olmadı.Siz yazdığınız gibi kullanın,yada istediklerinizi formülle birer sütuna yazın o sütundan tek bir aralık olarak alın.

 

[mersilen]

evren bey
dosyayı incelemeniz mümkün mü?
yaptıklarımzı asıl tabloya ekledim ama çalışmadı

tablo 1: tablo11
tablo 2: tablo11.1
tablo 3: tablo12 ye karşılık geliyor


Private Sub Worksheet_Change
Private Sub Worksheet_Change1 bundan ikitane macro içermesi sorun yaratabilir mi?

 

[mersilen]

arkadaşlar

kodu çalıştırdığımda kısır döngü oluşuyor gibi !
inceleyebilir misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c895:r925]) Is Nothing Then Exit Sub
On Error Resume Next
'Sirali_yaz_59
Dim i As Byte, k As Byte, sat As Byte, sut As Byte
Sheets("Sayfa1").Select
Range("c841:ad871").ClearContents
sat = 841
For i = 802 To 832
sut = 3
For k = 3 To 31
If Cells(i, k).Value <> "" Then
Cells(sat, sut).Value = Cells(i, k).Value
sut = sut + 1
End If
Next
sat = sat + 1
Next i
'MsgBox "İşlem tamamlandı" & vbLf & _
'"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub

 

[mersilen]

selamlar
uzman arkadaşlar yardımcı olabilirler mi?

 

[mersilen]

Dim i , k , sat , sut As integer ile çözüm oluyor



sayfaları incelerken Korhan Ayhan beyin açıklamalarının birinin içinde cevabı buldum,
herkese kolay gelsin

Ben kodu örnek dosyanıza göre düzenlemiştim. Eğer siz daha fazla sayıda sütunda bu işlemi yapacağınızı belirtseydiniz kodu ona göre düzenlerdim.

Hata almanızın nedeni değişken tanımlamasındandır. BYTE değşkeni 0-255 arası değeri destekler. Siz 277 yazdığınız için üst sınırı aşmışsınız. Bu durumda kodu aşağıdaki şekilde değştirip kullanabilirsiniz.

Kod:

Option Explicit

Sub SIRALA()
Dim X As Integer

For X = 2 To 277
Range(Cells(2, X), Cells(65536, X)).Sort Key1:=Cells(2, X), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Next
End Sub

__________________