Verİyİ SÜzÜp Sonucu BaŞka Taba Yazma

ilkiliroglu · 9 Kasım 2006

arkadaşlar yaptığınız site ve yardımlarınız için öncelikle çok teşekkür ediyorum benim sorunum ekte gönderdiğim dosya şu şekilde çalışıyor bir taba(A) verileri giriyorum daha sonra ilgili tablara(B,C,D) bu veriler makro yardımıyla gönderiliyor lşimdi ise bir başka taba(E) verileri girdiğimde bu verilerin B tabındaki ilgili başlığın altına geçmesini istiyorum ancak E tabındaki A sutunundaki tarih bilgisinin B sutununda yazılmış olan sipariş nolarının hepsine bakarak yani siparişlere göre B tabındaki sipariş nolarına göre alğılamasını örneğin 445 nolu sipariş için başlanğıç tarihine 3 ekim bitiş tarihine 5 ekim demesini istiyorum bu bilgiyi B tabındaki M ve N sutunlarına c sutunundaki sipariş nosuna göre yazmalı yani ben E tabına ilgili verileri girmeliyim ve verileri aktar gibi bir tuşa bastıktan sonra B tabına baktığımda hangi saparişin hangi tarihte apre işlemine başladığını ve hangi tarihte bittiğini toplam ne kadar çalıştığını görmeliyim ben işin içinden çıkamadım umarım konuyu net anlatabilmişimdir yardımlarınız için şimdiden teşekkürler

titris · 10 Kasım 2006

Çözmek Lazım

Arkadaşım şunu biliyorum ki senin istediğinde yapılabilir ama; Anlattıklarını anlamak lazım bana göre bilmediğim bir iş olduğu için açıklamalarındanda anlamamam normaldir. Ancak daha ayrıntılı olarak açıklarsan elimden geldiği kadarıyla yardımcı olmaya çalışırım.

ilkiliroglu · 10 Kasım 2006

ilgin için teşekkürler aslında bütün mesele E tabından B tabına veri aktarmakta ben sadece bunuda basit bir örnek üzerinde forma ekleyebilirdim ama A tabıyla B,C,D tabları arasındaki veri transferinin bozulmasını istemedim şimdi en basit haliyle konuyu özetlemeye çalışacağım sayfa üzerinde A,B,C,D tabları arasındaki etkileşimi bozmadan E tabına veri girdiğimde örneğin 445 nolu siparişin ilk apre başlama tarihi 3 ekim bitiş tarihi ise 5 ekim bunu B tabındaki apre başlama ve apre bitiş kolonları altındaki satırlara yazdırmak istiyorum toplam apre süresi ise 3 ekimde 1 saat 4 ekimde 1 saat 5 ekimde 1 saat olmak üzere toplam 3 saat bu 3 saati de yine B tabındaki Toplam apre süresi sutunun altındaki 445 nolu siparişi gördüğü her satıra yazmasını istiyorum ancak 479 nolu sipariş gibi B tabında iki farklı satırda da aynı sipariş bulunuyorsa 479 u gördüğü iki satırada aynı bilgileri girmesi gerekiyor umarım anlatabilmişimdir ilginiz ve yardımlarınız için şimdiden çok saolun...

Korhan Ayhan · 16 Kasım 2006

Selamlar,

Ekte dosyanızda gerekli düzenlemeleri yaptım incelermisiniz.

ilkiliroglu · 16 Kasım 2006

teşekkür

merhabalar,

öncelikle ilginiz ve yardımıznız için çok teşekkür ederim gönderdiğiniz örnek tam istediğim gibi ancak B tabındaki p sutununa da E tabında veri aktarımı gerekiyor şöyleki E tabındaki aynı siparişe ait toplam m2 leri toplayarak b tabındaki P sutununun altında m, n, o sutunları gibi toplamları yazması gerekiyor...

dediğim gibi ilginiz ve yardımınız için çok teşekkürler ancak bu formatın üzerinde sürekli aynı mantıkla ama şekli değiştirerek değişiklikler yapıyorum bu yüzden bana işin mantığını kısaca anlatırsanız tekrar tekrar forumu işgal etmemiş olurum hemde diğer okuyucularda bu mantığı görmüş olur

bu bağlamda neden Sub AKTAR_1() ile başlayan makroyu yazmak zorunda kaldık
bir ikincisi de Sub AKTAR_2() ile başlayan makronun mantığı nedir kısaca açıklayabilirseniz çok sevinirim

saygılar

Korhan Ayhan · 16 Kasım 2006

Selamlar,

Kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod:

Sub AKTAR_2()
    Dim &#304;lk_Sat&#305;r, Son_Sat&#305;r As Long
    Set S1 = Sheets("B")
    Set S2 = Sheets("E")
    S1.[M2:Q65536].ClearContents
    &#304;lk_Sat&#305;r = 0
    Son_Sat&#305;r = 0
    
    For Each Aral&#305;k In S1.Range("C2:C" & S1.[C65536].End(3).Row)
        If Aral&#305;k <> 0 Then
        Adres = S2.Name & "!B3:B65536"
        S&#252;re = WorksheetFunction.SumIf(S2.[B3:B65536], Aral&#305;k, S2.[E3:E65536])
        Toplam_Metrekare = WorksheetFunction.SumIf(S2.[B3:B65536], Aral&#305;k, S2.[H3:H65536])
        If S&#252;re = 0 Then GoTo Devam
        &#304;lk_Sat&#305;r = S2.[B1:B65536].Find(Aral&#305;k).Row
        Son_Sat&#305;r = Evaluate("=SUMPRODUCT(MAX(ROW(" & Adres & ") * (" & Adres & " = " & Aral&#305;k & ")))")
        S1.Cells(Aral&#305;k.Row, "M") = S2.Cells(&#304;lk_Sat&#305;r, "A")
        S1.Cells(Aral&#305;k.Row, "N") = S2.Cells(Son_Sat&#305;r, "A")
        S1.Cells(Aral&#305;k.Row, "O") = Format(S&#252;re, "hh:mm")
        S1.Cells(Aral&#305;k.Row, "P") = Toplam_Metrekare
        S1.Cells(Aral&#305;k.Row, "Q") = S2.Cells(&#304;lk_Sat&#305;r, "I")
        End If
Devam:
    &#304;lk_Sat&#305;r = 0
    Son_Sat&#305;r = 0
    Next
    MsgBox "AKTARIM &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR...", vbInformation
End Sub

Kodun mantığını kavrayabilmek için ALT+F11 tuşlarına basın ve AKTAR_2 isimli makroyu F8 tuşu ile adım adım çalıştırıp işlemleri gözlemleyin. Ayrıca excel dersanesi bölümündeki bilgilere gözatmanızı tavsiye ederim.

ilkiliroglu · 17 Kasım 2006

teşekkür

sayın cost control

çok teşekkür ediyorum tamamen işimi gördü dediğiniz gibi mantığı anlamaya çalışacağım

iyi çalışmalar

ilkiliroglu · 17 Kasım 2006

düzeltme

arkadaşlar makro da bir kaç düzeltme yapmak gerekiyor ilginizi umuyorum gerekli açıklamaları ekteki dosya üzerinde bulabilirsiniz ben bi düzeltme yaptım ama sanırım yanlış oldu nerede hata yaptığımı gösterirseniz sevinirim

saygılar

Korhan Ayhan · 17 Kasım 2006

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İnceleyiniz. Ayrıca son eklediğiniz dosyanızı inceledim kendinize göre koda eklenti yapmak istemişsiniz fakat sıcaklık olarak yazdığınız veri 65-90 şeklinde ve bu veriyi aktarmak içinde Sıcaklık = WorksheetFunction.SumIf(S2.[B3:B65536], Aralık, S2.[I3:I65536]) şeklinde ekleme yapmışsınız. Burada kullanılan fonksiyon ETOPLA fonksiyonudur. Doğal olarak sizin sayfaya yazdığınız 65-90 şeklindeki bir ifade bu fonksiyon ile toplanamayacağı için sonucunuz hatalı olacaktır.

Dediğim gibi kodlara müdahale edebilmek için bazı temel ifadeleri iyice kavramanız gerekiyor aksi halde çok bocalarsınız.

ilkiliroglu · 17 Kasım 2006

teşekkür

merhaba,

yeniden teşekkürler kesinlikle ihtiyacımı karşıladı emeğinize sağlık

saygılar

ilkiliroglu · 1 Aralık 2006

hata

arkadaşlar ekte gönderdiğim dosya bu başlık altında sizlerin ekledikleriyle yapılmış son hali dosyada A ve E tablarından B tabına veri aktarımı yapan makrolar mevcut ancak E tabından B tabına aktarımda sorun yaşamaktayım gerekli açıklamayı dosyanın B ve E tablarında yaptım ilginiz için şimdiden teşekkürler

ilkiliroglu · 1 Aralık 2006

eklenti

ilgili dosya ektedir

Korhan Ayhan · 1 Aralık 2006

Selamlar,

Örnek dosyanızda E sayfasında iken aktarım işlemi yaptığınızda B sayfasında Q-R-S-T-U (bu sütunlara gelen değerleri E sayfasından kontrol ediniz.) sütunlarına aktarım yapılmaktadır. Oysa siz B sayfasında G sütunundaki sürenin yanlış olduğunu belirtmişsiniz. Aktarım işleminde G sütunu sadece A sayfasındaki aktarım işleminde kullanılmıştır. Bunu da kontrol ederseniz doğru değerlerin geldiğini görebilirsiniz.

Ayrıca 542EK gibi bir no yazdığımda aktarım yapılmamakta demişsiniz. Aktarım esnasında birebir uyan kodlara işlem yapılmaktadır. Eğer bu şekilde noların sonunda "EK" gibi bir ifade geçenleride aktarsın derseniz kodu tekrar düzenlemek gerekecektir.

ilkiliroglu · 2 Aralık 2006

sayın cost control
sip noların sonuna EK gibi bir ifadenin gelme durumu söz konusu kodda ne gibi bir düzenleme yapabilirim ilginiz için teşekkürler

Korhan Ayhan · 2 Aralık 2006

Selamlar,

A ve B sayfanızı tekrar kontrol ettiğimde C sütununuzda 475,1 - 542,1 gibi sipariş noları kullanmışsınız. Bunları kontrol ediniz. Bunun dışında AKTAR_1 ve AKTAR_2 kodunu aşağıdaki şekilde değiştirip denermisiniz. AKTAR_1 kodunda sadece "Aralık" ifadesini değiştirdim.

Kod:

Sub AKTAR_1()
    Dim Sat&#305;r As Long
    Set S1 = Sheets("A")
    Set S2 = Sheets("B")
    Set S3 = Sheets("C")
    Set S4 = Sheets("D")
    Sat&#305;r = 1
    
    For Each H&#252;cre In S1.Range("A4:A" & [A65536].End(3).Row)
    If H&#252;cre <> 0 Then
        Sat&#305;r = Sat&#305;r + 1
        S2.Cells(Sat&#305;r, "A") = H&#252;cre
        S2.Cells(Sat&#305;r, "B") = H&#252;cre.Offset(0, 1)
        S2.Cells(Sat&#305;r, "C") = H&#252;cre.Offset(0, 2)
        S2.Cells(Sat&#305;r, "D") = H&#252;cre.Offset(0, 3)
        S2.Cells(Sat&#305;r, "E") = H&#252;cre.Offset(0, 10)
        S2.Cells(Sat&#305;r, "F") = H&#252;cre.Offset(0, 9)
        S2.Cells(Sat&#305;r, "G") = H&#252;cre.Offset(0, 7)
        S2.Cells(Sat&#305;r, "H") = H&#252;cre.Offset(0, 69)
        S2.Cells(Sat&#305;r, "I") = H&#252;cre.Offset(0, 70)
        S2.Cells(Sat&#305;r, "J") = H&#252;cre.Offset(0, 8)
        S2.Cells(Sat&#305;r, "K") = H&#252;cre.Offset(0, 71)
        S2.Cells(Sat&#305;r, "L") = H&#252;cre.Offset(0, 11)
        S2.Cells(Sat&#305;r, "M") = H&#252;cre.Offset(0, 14)
        S2.Cells(Sat&#305;r, "N") = H&#252;cre.Offset(0, 25)
        S2.Cells(Sat&#305;r, "O") = H&#252;cre.Offset(0, 26)
        S2.Cells(Sat&#305;r, "P") = H&#252;cre.Offset(0, 27)
        End If
    Next
    
    Sat&#305;r = 1
    
    For Each H&#252;cre In S1.Range("A4:A" & [A65536].End(3).Row)
    If H&#252;cre <> 0 Then
        Sat&#305;r = Sat&#305;r + 1
        S3.Cells(Sat&#305;r, "A") = H&#252;cre
        S3.Cells(Sat&#305;r, "B") = H&#252;cre.Offset(0, 1)
        S3.Cells(Sat&#305;r, "C") = H&#252;cre.Offset(0, 2)
        S3.Cells(Sat&#305;r, "D") = H&#252;cre.Offset(0, 9)
        S3.Cells(Sat&#305;r, "E") = H&#252;cre.Offset(0, 7)
        S3.Cells(Sat&#305;r, "F") = H&#252;cre.Offset(0, 13)
        S3.Cells(Sat&#305;r, "G") = H&#252;cre.Offset(0, 11)
        S3.Cells(Sat&#305;r, "H") = H&#252;cre.Offset(0, 12)
        S3.Cells(Sat&#305;r, "I") = H&#252;cre.Offset(0, 14)
        S3.Cells(Sat&#305;r, "J") = H&#252;cre.Offset(0, 15)
        S3.Cells(Sat&#305;r, "K") = H&#252;cre.Offset(0, 16)
        S3.Cells(Sat&#305;r, "L") = H&#252;cre.Offset(0, 17)
        S3.Cells(Sat&#305;r, "M") = H&#252;cre.Offset(0, 18)
        S3.Cells(Sat&#305;r, "N") = H&#252;cre.Offset(0, 19)
        S3.Cells(Sat&#305;r, "O") = H&#252;cre.Offset(0, 20)
        S3.Cells(Sat&#305;r, "P") = H&#252;cre.Offset(0, 21)
        S3.Cells(Sat&#305;r, "Q") = H&#252;cre.Offset(0, 30)
        S3.Cells(Sat&#305;r, "R") = H&#252;cre.Offset(0, 31)
        S3.Cells(Sat&#305;r, "S") = H&#252;cre.Offset(0, 32)
        S3.Cells(Sat&#305;r, "T") = H&#252;cre.Offset(0, 33)
        S3.Cells(Sat&#305;r, "U") = H&#252;cre.Offset(0, 34)
        S3.Cells(Sat&#305;r, "V") = H&#252;cre.Offset(0, 35)
        S3.Cells(Sat&#305;r, "W") = H&#252;cre.Offset(0, 36)
        End If
    Next
    
    Sat&#305;r = 1
    
    For Each H&#252;cre In S1.Range("A4:A" & [A65536].End(3).Row)
    If H&#252;cre <> 0 Then
        Sat&#305;r = Sat&#305;r + 1
        S4.Cells(Sat&#305;r, "A") = H&#252;cre
        S4.Cells(Sat&#305;r, "B") = H&#252;cre.Offset(0, 1)
        S4.Cells(Sat&#305;r, "C") = H&#252;cre.Offset(0, 2)
        S4.Cells(Sat&#305;r, "D") = H&#252;cre.Offset(0, 7)
        S4.Cells(Sat&#305;r, "E") = H&#252;cre.Offset(0, 13)
        S4.Cells(Sat&#305;r, "F") = H&#252;cre.Offset(0, 4)
        S4.Cells(Sat&#305;r, "G") = H&#252;cre.Offset(0, 5)
        S4.Cells(Sat&#305;r, "H") = H&#252;cre.Offset(0, 6)
        S4.Cells(Sat&#305;r, "I") = H&#252;cre.Offset(0, 43)
        S4.Cells(Sat&#305;r, "J") = H&#252;cre.Offset(0, 44)
        S4.Cells(Sat&#305;r, "K") = H&#252;cre.Offset(0, 45)
        S4.Cells(Sat&#305;r, "L") = H&#252;cre.Offset(0, 46)
        S4.Cells(Sat&#305;r, "M") = H&#252;cre.Offset(0, 47)
        S4.Cells(Sat&#305;r, "N") = H&#252;cre.Offset(0, 48)
        S4.Cells(Sat&#305;r, "O") = H&#252;cre.Offset(0, 57)
        S4.Cells(Sat&#305;r, "P") = H&#252;cre.Offset(0, 58)
        S4.Cells(Sat&#305;r, "Q") = H&#252;cre.Offset(0, 63)
        S4.Cells(Sat&#305;r, "R") = H&#252;cre.Offset(0, 64)
        S4.Cells(Sat&#305;r, "S") = H&#252;cre.Offset(0, 59)
        S4.Cells(Sat&#305;r, "T") = H&#252;cre.Offset(0, 60)
        S4.Cells(Sat&#305;r, "U") = H&#252;cre.Offset(0, 61)
        S4.Cells(Sat&#305;r, "V") = H&#252;cre.Offset(0, 62)
        S4.Cells(Sat&#305;r, "W") = H&#252;cre.Offset(0, 28)
        S4.Cells(Sat&#305;r, "X") = H&#252;cre.Offset(0, 29)
        End If
    Next
        MsgBox "AKTARIM &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR...", vbInformation
End Sub

Kod:

Sub AKTAR_2()
    Dim &#304;lk_Sat&#305;r, Son_Sat&#305;r As Long
    Set S1 = Sheets("B")
    Set S2 = Sheets("E")
    S1.[M2:Q65536].ClearContents
    &#304;lk_Sat&#305;r = 0
    Son_Sat&#305;r = 0
    
    For Each H&#252;cre In S1.Range("C2:C" & S1.[C65536].End(3).Row)
        If H&#252;cre <> 0 Then
        Adres = S2.Name & "!B3:B65536"
        Toplam_Metrekare = WorksheetFunction.SumIf(S2.[B3:B65536], H&#252;cre, S2.[H3:H65536])
    
    For Each Alan In S2.Range("B3:B" & S2.[B65536].End(3).Row)
        If InStr(Alan, H&#252;cre) > 0 Then
        S&#252;re = S&#252;re + Alan.Offset(0, 3)
        End If
    Next
        
        If S&#252;re = 0 Then GoTo Devam
        &#304;lk_Sat&#305;r = S2.[B1:B65536].Find(H&#252;cre).Row
        Son_Sat&#305;r = Evaluate("=SUMPRODUCT(MAX(ROW(" & Adres & ") * (" & Adres & " = " & H&#252;cre & ")))")
        S1.Cells(H&#252;cre.Row, "Q") = S2.Cells(&#304;lk_Sat&#305;r, "A")
        S1.Cells(H&#252;cre.Row, "R") = S2.Cells(Son_Sat&#305;r, "A")
        S1.Cells(H&#252;cre.Row, "S") = Format(S&#252;re, "hh:mm")
        S1.Cells(H&#252;cre.Row, "T") = Toplam_Metrekare
        S1.Cells(H&#252;cre.Row, "U") = S2.Cells(&#304;lk_Sat&#305;r, "I")
        End If

Devam:
    &#304;lk_Sat&#305;r = 0
    Son_Sat&#305;r = 0
    S&#252;re = 0
    Next
    MsgBox "AKTARIM &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR...", vbInformation
End Sub

ilkiliroglu · 4 Aralık 2006

sayın cost_control
e tabında 528-34 gibi bir ifade kullandığımda
S1.Cells(Hücre.Row, "R") = S2.Cells(Son_Satır, "A") bu satırda hata veriyor verdiğiniz kodları kullandım ama sonuç yine aynıydı konunun uzmanı değilim ama ilgili sutundaki sayıları metin olarak görse sorunumuz çözülür mü acaba yani kodlamada onları metin olarak gösterebilirmiyiz

selamlar

Korhan Ayhan · 4 Aralık 2006

Selamlar,

Bu durumda 528-34 ile 528 verisi tek veri olarak düşünülüp o şekildemi aktarılacak?

ilkiliroglu · 4 Aralık 2006

528 bir sipariş numarası ama bazen birbirine bağlı siparişleri üretime sokuyorum 528 den 534 e kadar olan siparişler beraber çıkacaksa buna528-34 nolu sipariş demem gerekiyor sorunuzun cevabı umarım budur

Korhan Ayhan · 4 Aralık 2006

Selamlar,

Anladığım kadarıyla kodu yeniden düzenledim. Aşağıdaki şekilde denermisiniz.

Kod:

Sub AKTAR_2()
    On Error Resume Next
    Dim İlk_Satır, Son_Satır As Long
    Set S1 = Sheets("B")
    Set S2 = Sheets("E")
    S1.[Q2:U65536].ClearContents
    İlk_Satır = 0
    Son_Satır = 0
    Toplam_Metrekare = 0
    Süre = 0
    
    For Each Hücre In S1.Range("C2:C" & S1.[C65536].End(3).Row)
        If Hücre <> 0 Then
    For Each Alan In S2.Range("B3:B" & S2.[B65536].End(3).Row)
        If InStr(Alan, Hücre) > 0 Or InStr(Hücre, Alan) > 0 Then
        Toplam_Metrekare = Toplam_Metrekare + Alan.Offset(0, 6)
        Süre = Süre + Alan.Offset(0, 3)
        End If
    Next
        If Süre = 0 Or Toplam_Metrekare = 0 Then GoTo Devam
        İlk_Satır = S2.[B1:B65536].Find(Hücre).Row
    For Each Alan In S2.Range("B3:B" & S2.[B65536].End(3).Row)
        If InStr(Alan, Hücre) > 0 Or InStr(Hücre, Alan) > 0 Then
        Son_Satır = Alan.Row
        End If
    Next
        S1.Cells(Hücre.Row, "Q") = S2.Cells(İlk_Satır, "A")
        If Son_Satır = 0 Then
        S1.Cells(Hücre.Row, "R") = S2.Cells(İlk_Satır, "A")
        Else
        S1.Cells(Hücre.Row, "R") = S2.Cells(Son_Satır, "A")
        End If
        S1.Cells(Hücre.Row, "S") = Format(Süre, "hh:mm")
        S1.Cells(Hücre.Row, "T") = Toplam_Metrekare
        S1.Cells(Hücre.Row, "U") = S2.Cells(İlk_Satır, "I")
        End If
Devam:
    İlk_Satır = 0
    Son_Satır = 0
    Toplam_Metrekare = 0
    Süre = 0
    Next
    MsgBox "AKTARIM İŞLEMİ TAMAMLANMIŞTIR...", vbInformation
End Sub

ilkiliroglu · 4 Aralık 2006

kesinlikle doğru kodlama ilginiz için tekrar teşekkürler

Verİyİ SÜzÜp Sonucu BaŞka Taba Yazma

ilkiliroglu

titris

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

ilkiliroglu

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu

Korhan Ayhan

Administrator

ilkiliroglu