alt alta olan verileri yan yana yazma

[noneym]

Merhaba arkadaşlar

aynen bu şekilde yapmak istiyorum
yardımcı olabilirmisiniz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Listele()
    Dim S1 As Worksheet, Veri As Variant, Dizi As Object, X As Long
    Dim Son As Long, Sutun As Integer, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:C" & Son).Value2
   
    S1.Range("D:" & Replace(Cells(1, Columns.Count).Address(0, 0), 1, "")).Clear
   
    ReDim Liste(1 To UBound(Veri), 1 To 3)
   
    For X = LBound(Veri) To UBound(Veri)
        If Not Dizi.Exists(Veri(X, 2)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 2), Say
            Liste(Say, 1) = Veri(X, 3)
            Liste(Say, 2) = Veri(X, 2)
            Liste(Say, 3) = Veri(X, 1)
        Else
            Liste(Dizi.Item(Veri(X, 2)), 3) = Liste(Dizi.Item(Veri(X, 2)), 3) & "|" & Veri(X, 1)
        End If
    Next
   
    If Say > 0 Then
        S1.Range("D2").Resize(Say, 3) = Liste
        S1.Range("F2").Resize(Say).TextToColumns Tab:=True, OtherChar:="|"
        Sutun = S1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        With S1.Range("D1:E1")
            .Value = Array("Sıra No", "Stok Kodu")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
        With S1.Range("F1")
            .Value = "Fiyat 1"
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .AutoFill Destination:=S1.Range("F1:" & Cells(1, Sutun).Address(0, 0)), Type:=xlFillDefault
        End With
    End If
   
    Set S1 = Nothing
    Set Dizi = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[noneym]

Hocam normal formul olarak olabilirmi
kodu calıstıramıyorum

 

[Korhan Ayhan]

Kodu neden çalıştıramıyorsunuz.

 

[Korhan Ayhan]

Dosyanızı boş bir hücreyaçın.
ALT+F11 tuşlarına basın.
Karşınıza kod editörü açılacaktır.

INSERT menüsünden MODULE seçeneğini seçin. Sağ tarafta beyaz bir alan açılacaktır.

Bu alana verdiğim kodu uygulayın.
Excel sayfasına geri dönün.
EKLE menüsünden sayfanıza bir dikdörtgen ekleyin.
Şekil üzerinde sağ tıklayın ve MAKRO ATA komutuna tıklayın. Ekrana gelen pencereden makroyu seçip tamam deyin.

Son olarak boş bir hücreyi seçtikten sonra şekle tıklayın.

İstediğiniz sonuç oluşacaktır.

Dosyanızı kayıt ederken dosya türünden MAKRO İÇEREBİLEN EXCEL DOSYASI formatını seçiniz. Yoksa kodlar dosyadan silinir.

 

[Korhan Ayhan]

Formül olarak örnek resme göre aşağıdaki gibi uygulayarak sonuç alabilirsiniz.

E2;

=İNDİS($B:$B;SATIR()*4-6)

F2;

=İNDİS($A:$A;SATIR()*4-6+MOD(SÜTUN();6))

Sonrasında bu formülleri alt hücrelere sürükleyiniz.

 

[YUSUF44]

Sayın Korhan Ayhan, arkadaşın tablosunda gözünüzden kaçtı sanıyorum: tüm kodlar 4'er adet değil.

 

[noneym]

hocam kırmızı yerler hatalı

 

[Korhan Ayhan]

Haklısınız. Dikkatimden kaçmış.

Özür dilerim...

 

[Korhan Ayhan]

Yeni formüller aşağıdaki gibi olabilir.

DİZİ formüllerdir.

E2;

=EĞERHATA(İNDİS($B$2:$B$1000;KAÇINCI(0;EĞER($B$2:$B$1000<>"";EĞERSAY($E$1:E1;$B$2:$B$1000));0));"")

F2;

=EĞER($E2="";"";EĞERHATA(İNDİS($A$2:$A$1000;KÜÇÜK(EĞER($B$2:$B$1000=$E2;SATIR($B$2:$B$1000)-1);SÜTUNSAY($F$1:F$1)));""))

 

[noneym]

e sutunu boş

 

[Korhan Ayhan]

DİZİ formül olarak uygulayınız.

Formülü hücreye yazdıktan sonra hücreyi CTRL+SHIFT+ENTER tuşlarına basarak terk ediniz.

 

[noneym]

teşekkür ederim

 

[Korhan Ayhan]

Formüllere boş hücreleri atlaması için küçük eklemeler yaptım. Üstteki mesajımdan son hallerini deneyiniz.

 

[noneym]

boş hücre bıraktıktan sonra tekrar ekleme yapıyor

 

[noneym]

bu kodlara bakarmısınız


Kod:

=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0);0)







Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+1;0)









Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+2;0)









Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+3;0)









Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+4;0)









Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+5;0)









Kod:


=İNDİS($B:$B;KAÇINCI($F2;$A:$A;0)+6;0)

 

[Korhan Ayhan]

Resimdeki 4 Fiyat olması yanlış yönlendirdi.

F2 hücresi için formülü tekrar revize ettim. Üstteki mesajdan kontrol edip denersiniz.

 

[noneym]

tamam hocam oldu

d hücresine sıra no yu getirebilirmiyiz

 

[Korhan Ayhan]

Hangi sıra numarasını?

 

[noneym]

c hücresindeki