sayfa birdeki verileri sıralama

[MurCeLL]

Merhaba,

Sayfa birde bir kaç veri gireceğim bu verileri Sayfa ikide istediğim şekle göre sıralanacak bunu resimle anlatmaya çalıştım umarım anlata bildim umuyorum ki biri bana yardımcı olacak. şimdiden teşekkür ederim.

resimleri eklemeyi beceremedim

 

[YUSUF44]

REsim olarak değil örnek bir excel dosyası hazırlayıp ve dosya.tc, google drive gibi sitelerden birine yükleyip burada paylaşırsanız daha kolay çözüm bulursunuz. Altın üye olmadığınızdan bu siteye doğrudan yükleme yapamıyorsunuz maalesef.

 

[1Al2Ver]

Merhaba,

Sayfa birde bir kaç veri gireceğim bu verileri Sayfa ikide istediğim şekle göre sıralanacak bunu resimle anlatmaya çalıştım umarım anlata bildim umuyorum ki biri bana yardımcı olacak. şimdiden teşekkür ederim.

resimleri eklemeyi beceremedim

Merhaba,

Öneri ; Dosya yükleme sitelerine, örneğin Dosya.tc ve/veya benzeri
sitelere, örneklendirilmiş bir dosya eklerseniz, çabuk ve doğru çözüm alabilir siniz.

 

[MurCeLL]

teşekkür ederim. dediğiniz siteye şirket ten giremiyorum yasaklanmış. dosyaları yükleyemeyeceğim...

Buradan anlatmaya çalışayım kademe kademe anlatayım. birinci sayfada A1 hücresine elma yazdım B1 hücresine de 6 yazdım ( bu altı adet ) sayfa iki de alt alta elma yazmasını istiyorum adet kadar yani altı tane.

sayfa 1 : A1 elma B1 6
sayfa ikide aşağıdaki gibi olması lazım.

elma
elma
elma
elma
elma
elma

 

[YUSUF44]

Bu istediğiniz sadece bir veri için mi geçerli olacak?
İkinci veri nasıl kullanılacak?
İkinci veriyi yine Sayfa1 A1'e mi yazdıracaksınız yoksa A1 dolu olduğu için A2'ye mi yazdıracaksınız?
İkinci veri Sayfa2'deki eski verileri silip yerlerine mi yazılsın yoksa altına mı devam etsin?

 

[MurCeLL]

ikinci veriyi A2 hücresine yazacağım sayfa ikide eski verileri silmeyecek altına devam edecek.
sayfa 1:A1 hücresine elma yazdım 3 adet A2 hücresine armut yazdım 4 adet A3 hücresine muz yazdım 5 adet. bu şekilde verileri yazacağım. bu adetler sabit değil değişebilir.

sayfa 2:
elma
elma
elma
armut
armut
armut
armut
muz
muz
muz
muz
muz

 

[Orion1]

Buyurun.

Sub tekrar59()
Dim sonsat As Long, i As Long, k As Long, sat As Long
Range("D:D").ClearContents
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
sat = 1
For i = 1 To sonsat
    For k = 1 To Cells(i, "B").Value
        Cells(sat, "D").Value = Cells(i, "A").Value
        sat = sat + 1
    Next k
Next i
MsgBox "İşlem tamamlnadı" & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[MurCeLL]

teşekkür ederim. kafamdaki projenin ilk adımıydı bu

 

[Orion1]

teşekkür ederim. kafamdaki projenin ilk adımıydı bu

Rica ederim.
İyi çalışmalar.

 

[YUSUF44]

Alternatif olsun, bu kodları daha önce hazırlamıştım ama arada başka işim çıkınca buraya gönderememiştim. Aşağıdaki kodları Sayfa1'in kod bölümüne yapıştırırsanız A sütunu dolu ve B sütunu sayı olduğunda Sayfa2'de ilk boş yere istediğiniz eklemeyi yapar. Sayfa olayına bağlı olduğundan siz değişiklik yaptıkça çalışır, ayrıca çalıştırılmasına gerek yoktur:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B:B")) Is Nothing Then GoTo 10
If Target.Offset(0, -1) <> "" And IsNumeric(Target) = True Then
    yeni = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row + 1
    If Sheets("Sayfa2").[A1] = "" Then yeni = 1
    Sheets("Sayfa2").Range("A" & yeni & ":A" & yeni + Target - 1) = Target.Offset(0, -1)
End If
10:
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target <> "" And IsNumeric(Target.Offset(0, 1)) = True Then
    yeni = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row + 1
    If Sheets("Sayfa2").[A1] = "" Then yeni = 1
    Sheets("Sayfa2").Range("A" & yeni & ":A" & yeni + Target.Offset(0, 1) - 1) = Target
End If
End Sub

 

[MurCeLL]

teşekkür ederim. eline sağlık