tekrar sayısı belli verileri alt alta yazma

[modoste]

merhaba sayın hocalarım bu sorumda
ekli tablomda anlatmaya çalıştım gri renkli doğru çözümü formülle yapabilirmiyiz

 

[mami68]

Merhabalar

Sayın modoste,saymak derken B1 hücresinde =EĞERSAY($A$4:$A$16;A1) yazmanı gerekecektir,ve aşağı doğru kopyalayınız.

Yoksa isimlerin yanında son toplamımı arıyorsunuz karar veremedim.

 

[mami68]

Dosyayı incelemek istermisiniz.

 

[modoste]

sayın mami 68
bi yanlış anlaşılma olmuş eklediğim ilk tabolya göre tekrar açıklamaya çalışayım
A1:A3 arasındaki (gökhan-ali-kamil) bu verileri manuel yazdım
B1:B3 arasındaki (4-7-2) sayılarınıda manuel yazdım
istediğim şey gri renkli başlayan A4 hücresinden başlayarak aşağıya doğru A1:A3 arasına yazdığım verileri tekrar sayıları kadar (4-7-2) alt alta yazmak

 

[detay26]

sn. modeste yanıt bulabildiniz mi?

 

[detay26]

aynı problem için çözümü ararken forumda buldum konuyu, 2009'da kapanmış, ustalardan rica etsem bir bakabilirler mi? modeste'nin örnek dosyasındaki gibi, bir sütundaki veriyi, yanındaki tekrar sayısınca (veya frekansınca) alt alta veri tabanı formatında yazmak istiyorum, şimdiden çok teşekkürler..

 

[muygun]

aynı problem için çözümü ararken forumda buldum konuyu, 2009'da kapanmış, ustalardan rica etsem bir bakabilirler mi? modeste'nin örnek dosyasındaki gibi, bir sütundaki veriyi, yanındaki tekrar sayısınca (veya frekansınca) alt alta veri tabanı formatında yazmak istiyorum, şimdiden çok teşekkürler..

Merhaba;
Eki inceleyin.
İyi çalışmalar.

 

[detay26]

sorunun cevabını http://www.excel.web.tr/f47/belirli-tablodan-artly-veri-alyp-ba-ka-tablo-t79328.html adresinde buldum, muygun hocaya teşekkürler..

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak makro ile hazırladığım örnek dosyayı incelermisiniz.

A sütununa isimleri giriniz. B sütununuda tekrar sayılarını giriniz. Giriş yaptıkça listeler yenilenir.

Kullanılan kod; (Sayfanın kod bölümüne uygulayınız.)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
    [C2:D65536] = ""
    
    ADET = WorksheetFunction.Sum([B2:B65536])
    If ADET = 0 Then
        MsgBox "Listeleme yapabilmeniz için B sütununa değer girmelisiniz !", vbExclamation, "DİKKAT !"
        Exit Sub
    End If
    
    If ADET > 65535 Then
        MsgBox "B sütununa gidiğiniz adet miktarları çok fazla lütfen girdiğiniz değerleri kontrol ediniz !", vbCritical, "DİKKAT !"
        Exit Sub
    End If
    
    For X = 2 To [A65536].End(3).Row
        For Y = 1 To Cells(X, "B")
            Cells([C65536].End(3).Row + 1, "C") = Cells(X, "A")
        Next
    Next
    
    For X = [A65536].End(3).Row To 2 Step -1
        For Y = 1 To Cells(X, "B")
            Cells([D65536].End(3).Row + 1, "D") = Cells(X, "A")
        Next
    Next
    
    MsgBox "Listeleme işlemi tamamlanmıştır.", vbInformation
End Sub