Düşeydeki veriyi yatay sutuna getirme

[greengarden77]

Merhaba arkadaşlar ekte örnek bir dosya gönderiyorum , düşeydeki veriyi yatayda göstermek istiyorum . bayram dönüşü rapor yapmam gerekiyor veriler çok oldugundan çok vakıt alacak , bu soru nasıl çözebilirim , yardımcı olurmsunuz.

şimdiden tesekurler

 

[qerta]

İstediğiniz hücre üzerine gelip 'kopyala' diyorsunuz,kopyalama yaptığınız hücreyi nereye yapıştırmanız gerekiyorsa ''sağa'' tıklayıp ''özel yapıştır'' deyip çıkan sayfada hangi türü seçeceksiniz ''işlemi tersine çevir'' i işaretleyip yapıştırıyorsunuz.

 

[greengarden77]

İstediğiniz hücre üzerine gelip 'kopyala' diyorsunuz,kopyalama yaptığınız hücreyi nereye yapıştırmanız gerekiyorsa ''sağa'' tıklayıp ''özel yapıştır'' deyip çıkan sayfada hangi türü seçeceksiniz ''işlemi tersine çevir'' i işaretleyip yapıştırıyorsunuz.

teskurler yanıtnız için fakat tam isteğimi anlayamadınız sanırım dinamık calısan bir formul yapmak ıstıyorum ,bu konuda yardımcı olursanız cok sevınırım.

 

[Muhammet Okumuş]

Merhaba,
Eğer makro işnizi görecekse

Sub Grupla()
Set s = Sheets("Sayfa1")
son = s.Cells(Rows.Count, "A").End(3).Row

For i = 2 To son
For j = 2 To son

If s.Cells(j, 1) = Cells(i, 1) Then
süt = WorksheetFunction.CountA(Range("B" & i & ":BB" & i)) + 2
Cells(i, süt) = s.Cells(j, 2)
End If

Next
Next

End Sub

Kodunu deneyiniz.

 

[greengarden77]

Merhaba,
Eğer makro işnizi görecekse


Kodunu deneyiniz.

muhammet bey teskurler fakat makro da csutunda 2 aynı veriyi arka arkaya atmıyor sadece bir tanesını atıyor? bır de makroyu her calıstırdıgında veri atıyor , bu ilerde problem yapmama sebep olabilir , makro olrak düşünmenız guzel olmus , bu kucuk sorunları gıderebılırsek cok ıyı olacak

tesekkurler

 

[Muhammet Okumuş]

Sayfa1 deki filtreyi kaldırın. Büyük /küçük harfe dikkat ediniz. Kodun başına
Range("B2:BB1000") = ""
ilave ediniz.

 

[greengarden77]

Sayfa1 deki filtreyi kaldırın. Büyük /küçük harfe dikkat ediniz. Kodun başına
Range("B2:BB1000") = ""
ilave ediniz.

muhammet bey elınıze saglık tesekurler , kucuk bir isteğim daha olsa sayfa 1 deki c sutununda bulunan sayıları sayfa 2 yataya gelen sayıların hücresine makro ıle açıklama not olrak eklenebilirmi ?

 

[Necdet]

Merhaba,

Alternatif olsun.

Sayfa1 de olan değerler sayfa2 de yoksa ekler.

    Dim i   As Long, _
        j   As Long, _
        Kol As Integer, _
        c   As Range, _
        s1  As Worksheet, _
        s2  As Worksheet
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    On Error Resume Next
    s1.Select
    If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter
    s2.Select
    
    s2.Range(Cells(2, "B"), s2.Cells(Rows.Count, Columns.Count)).ClearContents
    For i = 2 To s1.Cells(Rows.Count, "a").End(3).Row
        
        Set c = s2.Range("a:a").Find(s1.Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            j = c.Row
        Else
            j = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s2.Cells(j, "A") = s1.Cells(i, "A")
        End If
        
        Kol = s2.Cells(j, Columns.Count).End(1).Column + 1
        
        With s2.Range(s2.Cells(j, Kol).Address)
            .ClearComments
            .AddComment "Pt. Hafta : " & s1.Cells(i, "C")
            .Value = s1.Cells(i, "B")
       End With
       
    Next i
    
    i = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Range("a2:C" & i).Sort Key1:=s1.Range("C1")
    Application.ScreenUpdating = False
    
End Sub

 

[greengarden77]

Necdet bey elinize sağlık , çok güzel olmus, bir sorum olcak c sutunda tarih oldugunda sıralama yapmıyor , ben hafta olrak yapmıstım kusura bakmayın yanlış dusunmusum tarih olması gerekıyor tarihe gore sıralama olması gerekıyor , tarih yazdığım da olmadı , makroya ilave gerekıyor galiba ,

 

[Necdet]

Merhaba,

Sıralama yaptırmadım ki
Sayfa1 C sütunu mu sıralanacak?

Dosya ve kodlar yenilendi.

 

[Muhammet Okumuş]

Sn Necdet Bey,
Yazmış olduğunuz kodlarla bizlere ışık oluyorsunuz.
Kol = s2.Cells(j, Columns.Count).End(1).Column + 1
Bu son sütun kalıbını bilmiyordum. Hep CountA kullanarak son sütunu buluyordum.

Set c = s2.Range("a:a").Find(s1.Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
j = c.Row
Else
j = s2.Cells(Rows.Count, "A").End(3).Row + 1
s2.Cells(j, "A") = s1.Cells(i, "A")
End If

Burda ki mantık çok güzel gerçekten.

Sondaki

Application.ScreenUpdating = False farketmez belki ama False değil de True olması gerkmiyor muydu?

 

[Necdet]

Merhaba,

Sondaki tabi ki True olmalı, kopyalayıp yapıştırıp sonra aklınıza başka bir şey gelince unutuyorsunuz işte