Stok adetlerini tek sütuna aktarmak

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Merhabalar

Örnek dosyada A sütununda ürün kodları, B,C,D sütunlarında depolardaki adetleri vardır.

Depolardaki bu adetleri, F,G,H sütunlarındaki gibi oluşturabilir miyiz?

Eğer mümkünü varsa formülle lütfen, (hatta alternatif formüller de çok iyi oluyor) ; formüllerle olmuyorsa makroyla rica ederim. Saygılar

(Ürün kodları, depolar, adetler değişkendir)

 
Makrolu çözüm;

C++:
Option Explicit

Sub Stok_Analizi()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Range("J2:L" & Rows.Count).ClearContents
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = Range("A1:D" & Son).Value
    
    ReDim Liste(1 To ((UBound(Veri, 1) - 1) * (UBound(Veri, 2) - 1)), 1 To 3)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Left(Veri(X, 1), 3) = "STK" Then
            For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, Y)
                Liste(Say, 3) = Veri(1, Y)
            Next
        End If
    Next
    
    Range("J2").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    Columns.AutoFit
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Formülle çözüm;

J2;
C++:
=KAYDIR($A$1;YUKARIYUVARLA(SATIRSAY($A$2:$A2)/3;0);;;)

K2;
C++:
=KAYDIR($A$1;YUKARIYUVARLA(SATIRSAY($A$2:$A2)/3;0);MOD(SATIR()-2;3)+1;;)

L2;
C++:
=KAYDIR($A$1;0;MOD(SATIR()-2;3)+1;;)
 
Formülle alternetif
J2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,1)+2;SÜTUN(A$1)));"")
K2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,1)+2;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
L2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SÜTUN(A1)/3,1)+1;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
 
Formülle çözüm;

J2;
C++:
=KAYDIR($A$1;YUKARIYUVARLA(SATIRSAY($A$2:$A2)/3;0);;;)

K2;
C++:
=KAYDIR($A$1;YUKARIYUVARLA(SATIRSAY($A$2:$A2)/3;0);MOD(SATIR()-2;3)+1;;)

L2;
C++:
=KAYDIR($A$1;0;MOD(SATIR()-2;3)+1;;)
Sayın uzmanım harika çözüm oldu. Sağolunuz teşekkürler.
 
Formülle alternetif
J2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,1)+2;SÜTUN(A$1)));"")
K2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,1)+2;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
L2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3>SATIR();DOLAYLI(ADRES(TAMSAYI(SÜTUN(A1)/3,1)+1;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
Sayın çıtır çok teşekkürler, sebebini anlayamadım ama STK11 den itibaren kayma yaptı. Neden daha önce değil de STK11 den sonra yaptı anlayamadım.
 
Formülle alternetif
J2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,001)+2;SÜTUN(A$1)));"")
K2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,001)+2;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
L2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SÜTUN(A1)/3,001)+1;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
Yukardaki formüller doğru sonuç verir.
 
Formülle alternetif
J2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,001)+2;SÜTUN(A$1)));"")
K2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SATIR(A1)/3,001)+2;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
L2;
Kod:
=EĞER(BAĞ_DEĞ_DOLU_SAY(A:A)*3-1>SATIR();DOLAYLI(ADRES(TAMSAYI(SÜTUN(A1)/3,001)+1;SATIR($A$2)+MOD(SATIR(A1)-1;3)));"")
Yukardaki formüller doğru sonuç verir.
Sayın çıtır dönüş yapmayı unuttum Bu formüller doğru sonuç verdi. Teşekkürler
 
Makrolu çözüm;

C++:
Option Explicit

Sub Stok_Analizi()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Range("J2:L" & Rows.Count).ClearContents
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = Range("A1:D" & Son).Value
   
    ReDim Liste(1 To ((UBound(Veri, 1) - 1) * (UBound(Veri, 2) - 1)), 1 To 3)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Left(Veri(X, 1), 3) = "STK" Then
            For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, Y)
                Liste(Say, 3) = Veri(1, Y)
            Next
        End If
    Next
   
    Range("J2").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    Columns.AutoFit
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub


Sayın Korhan Ayhan uzmanım merhaba

Kodlarda iki küçük değişiklik isteyebilir miyim,

Birincisi, hani makro kodlarının içinde (benim örnek dosyamda A sütunu öyle olduğu için) STK harfleri geçiyor ya, (hatta tırnak içinde yazılmış)

İşte her dosyada kullanabileyim diye, dosyaya özgü değil de standart hale getirebilir miyiz?
Yani A sütununa ne yazarsam dökümü yapsın


İkincisi de, örnek dosyamda D sütununa kadar geçerliydi,
G sütununa kadar geçerli olacak şekilde değiştirir misiniz,

Başka zaman sütun sayısı daha da arttığı zaman, eski makro kodlarıyla yeni makro kodları arasındaki farklara bakıp (genelde hep böyle yapıyorum :) değişiklip yapabilirim.

Teşekkürler
 
Deneyiniz.

C++:
Option Explicit

Sub Stok_Analizi()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Range("J2:L" & Rows.Count).ClearContents
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = Range("A1:G" & Son).Value
    
    ReDim Liste(1 To ((UBound(Veri, 1) - 1) * (UBound(Veri, 2) - 1)), 1 To 3)
    
    For X = 2 To UBound(Veri, 1)
        For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Veri(X, Y)
            Liste(Say, 3) = Veri(1, Y)
        Next
    Next
    
    Range("J2").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    Columns.AutoFit
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Deneyiniz.

C++:
Option Explicit

Sub Stok_Analizi()
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Range("J2:L" & Rows.Count).ClearContents
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = Range("A1:G" & Son).Value
   
    ReDim Liste(1 To ((UBound(Veri, 1) - 1) * (UBound(Veri, 2) - 1)), 1 To 3)
   
    For X = 2 To UBound(Veri, 1)
        For Y = LBound(Veri, 2) + 1 To UBound(Veri, 2)
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Veri(X, Y)
            Liste(Say, 3) = Veri(1, Y)
        Next
    Next
   
    Range("J2").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    Columns.AutoFit
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Hemen deniyorum uzmanım.
 
Geri
Üst