Stok adetlerini tek sütuna aktarmak

I

izcik

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)

ornek.xls dosyasını indir - download

ornek.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle
www.dosya.tc www.dosya.tc
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,708
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,708
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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;;)
 
Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
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)));"")
 
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Korhan Ayhan' Alıntı:
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;;)
Genişletmek için tıkla ...
Sayın uzmanım harika çözüm oldu. Sağolunuz teşekkürler.
 
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
çıtır' Alıntı:
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)));"")
Genişletmek için tıkla ...
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.
 
Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
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.
 
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
çıtır' Alıntı:
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.
Genişletmek için tıkla ...
Sayın çıtır dönüş yapmayı unuttum Bu formüller doğru sonuç verdi. Teşekkürler
 
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...

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
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,708
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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
 
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...
Hemen deniyorum uzmanım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst