• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

2. Sayfaya Girilen Veri ile ilk sayfada tablo doldurma

  • Konbuyu başlatan Konbuyu başlatan DMR 7
  • Başlangıç tarihi Başlangıç tarihi
DMR 7

DMR 7

Katılım
14 Eylül 2017
Mesajlar
129
Excel Vers. ve Dili
2016 / Tr
Merhabalar,

Ekteki excelde "SİPARİŞ LİSTESİ" sayfasına girdiğim 4 veriye bağlı olarak "Planlama Çizelgesi" Sayfasında bazı değişiklikler yapılmasını istiyorum.

Örnek vermek gerekirse;

"SİPARİŞ LİSTESİ" sayfasındaki,

EX.4444.333.1610
ABC TEKNİK

için ""Planlama Çizelgesi" sayfasına "ABC TEKNİK, 16T-10M" yazıyorum.

Mantık basit;

2. satırdaki firma adını yazıyorum.
virgül "," ile ayırıyorum.
EX ile başlayan kodun son 4 hanesindeki ilk 2 rakamı "16" yazıp sonuna "T" harfi koyuyorum.
daha sonra tire "-" koyuyorum.
EX ile başlayan kodun son 4 hanesindeki son 2 rakamı "10" yazıp sonuna "M" harfi koyuyorum.

DMR 7' Alıntı:
Kodun sonu sabit değil hocam, 3 nokta 4 ayrı veri parçadan oluşuyor, fakat bazen " -1" veya " -2" gibi değerler gelebiliyor. Baştan sayılırsa sabit oluyor ama ilk 12 karakterden sonraki 4 karakter ile ilgileniyorum.
Genişletmek için tıkla ...



Adetleri olduğu gibi geçiriyorum.

Daha sonra teslim tarihinden geriye doğru 8 haftayı, ilk sayfadaki çizelgeye göre boyuyorum.
Birleştir ortala yapıp sağa yaslıyorum ve hücreye teslim tarihini yazıp boyuyorum.


Yapmak istediğim. 2. sayfaya her kayıt girdiğimde ilk sayfaya otomatik olarak bunların bir alt satıra yapılması.

Bu konuda yardımcı olabilir misiniz?

İlgili dosya: http://www.dosya.tc/server10/ccq2ha/SIPARIS.xlsx.html
 
Son düzenleme:
Örneğinizdeki EX.4444.333.1610 ifadesinin uzunluğu sabit mi? Yoksa değişken mi. Değil ise 4 parçadan mı oluşuyor.Yani 3 nokta 4 ayrı veri mi var.
 
askm' Alıntı:
Örneğinizdeki EX.4444.333.1610 ifadesinin uzunluğu sabit mi? Yoksa değişken mi. Değil ise 4 parçadan mı oluşuyor.Yani 3 nokta 4 ayrı veri mi var.
Genişletmek için tıkla ...


Kodun sonu sabit değil hocam, 3 nokta 4 ayrı veri parçadan oluşuyor, fakat bazen " -1" veya " -2" gibi değerler gelebiliyor. Baştan sayılırsa sabit oluyor ama ilk 12 karakterden sonraki 4 karakter ile ilgileniyorum.

Bir de takvim 2017 -2018 olduğunda falan da kullabilcek miyim?
 
Son düzenleme:
Takvimle ilgisini anlamadım.
 
askm' Alıntı:
Takvimle ilgisini anlamadım.
Genişletmek için tıkla ...

Neyi anlamadığını çözemedim ama örnek vereyim.

SS'teki ilk satır için teslim tarihi 20.09.2016.

eylül 20si yılın 38. haftasına denk geliyor. yani 31. haftadan 38. haftaya kadar 8 hafta boyayacağım.

bLXPOd.png


Şuanki liste 2017. haliyle dinamik olacak. yarın 2018'in haftaları tabloya eklenecek tarihler değişecek
 
Son düzenleme:
Merhaba.

Sorunuzu, ekran görüntüsü yerine gerçek belgenizle aynı yapıda bir örnek belge
üzerinden sorarsanız daha hızlı ve net çözüme ulaşabilirsiniz.

Örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA bölümünde var.

Bir örnek belge yüklerseniz ben veya başka bir üye sorunuzu cevapsız bırakmayacaktır.
.
 
Ömer BARAN' Alıntı:
Merhaba.

Sorunuzu, ekran görüntüsü yerine gerçek belgenizle aynı yapıda bir örnek belge
üzerinden sorarsanız daha hızlı ve net çözüme ulaşabilirsiniz.

Örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA bölümünde var.

Bir örnek belge yüklerseniz ben veya başka bir üye sorunuzu cevapsız bırakmayacaktır.
.
Genişletmek için tıkla ...
Merhaba hocam,

ilk mesajımda dosya linki vardı. link mi kırık ?

DMR 7' Alıntı:
İlgili dosya: http://www.dosya.tc/server10/ccq2ha/SIPARIS.xlsx.html
Genişletmek için tıkla ...



ha bu arada buradan farklı olarak, sipariş no kısmı başka bir sayfadaki verilerden açılır liste ile seçiliyor. ordaki veriyi değiştirmeye izin vermeyebilir. önemli mi bilmiyorum
 
Son düzenleme:
Merhaba
Ek dosyayı deneyiniz
http://s7.dosya.tc/server/cn6203/SIPARIS2.zip.html
"A: D" sütunlarından birindeki hücreye (satırdaki dört hücrede dolu olduğu halde) veri girildiğinde
aktarmayı yapacaktır.
Bilgisayar tarih formatı "dd.mm.yyyy" şeklinde olduğu varsayılarak
Mükerrer kayıt için bir ekleme yapılmadı.
Deneyin eksikliklerde, ekleme yaparız.
Kod: 
[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr1 As String
If Selection.Cells.Count <> 1 Then MsgBox "Birden fazla hücrede işlem yapılmaz": Exit Sub
If Intersect(Target, [A:D]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("A" & Target.Row & ":D" & Target.Row), "") <> 0 Then Exit Sub
If Len(Cells(Target.Row, "A")) < 12 Then Cells(Target.Row, "A").Select: _
MsgBox "Seçili hücrede en az 12 harf olmalı, işlem yapılmadı": Exit Sub
x = UBound(Split(Cells(Target.Row, "A"), Chr(10)))
If x = 0 And Cells(Target.Row, "A") <> "" Then _
MsgBox "A" & Target.Row & "hücresinde 2.satır yok, işlem yapılmadı ": Exit Sub
x = Right(Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(0)), 4)
x1 = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(1))
x2 = Left(x, 2) & "T-" & Right(x, 2) & "M"
x = x1 & ", " & x2
tr1 = Format(Cells(Target.Row, "C"), "mmm.yy")
Set s1 = Sheets("PLANLAMA ÇİZELGESİ")
cl = s1.Cells(1, Columns.Count).End(xlToLeft).Column
For n = 2 To cl + 1
If IsDate(s1.Cells(1, n)) = True Then
If Month(s1.Cells(1, n)) = Month(Cells(Target.Row, "C")) And _
Year(s1.Cells(1, n)) = Year(Cells(Target.Row, "C")) Then Exit For
End If: Next
If n > cl Then MsgBox Cells(Target.Row, "C") & "Ay-yıl 1. sayfada yok işlem yapılmadı": Exit Sub
kç = Cells(Target.Row, "C") - CDate("31.12." & Year(Cells(Target.Row, "C")) - 1)
kç = WorksheetFunction.MRound(kç / 7, 1)
For a = n To n + 3
If CDbl(Left(Trim(s1.Cells(2, a)), Len(kç))) = CDbl(kç) Then st = a: Exit For
Next
For n2 = 2 To cl + 1
If IsDate(s1.Cells(1, n2)) = True Then
If Month(s1.Cells(1, n2)) = Month(Cells(Target.Row, "D")) And _
Year(s1.Cells(1, n2)) = Year(Cells(Target.Row, "D")) Then Exit For
End If: Next
If n2 > cl Then MsgBox Cells(Target.Row, "D") & "Ay-yıl 1. sayfada yok işlem yapılmadı": Exit Sub
kç2 = Cells(Target.Row, "D") - CDate("31.12." & Year(Cells(Target.Row, "D")) - 1)
kç2 = WorksheetFunction.MRound(kç2 / 7, 1)
For a2 = n2 To n2 + 3
If CDbl(Left(Trim(s1.Cells(2, a2)), Len(kç2))) = CDbl(kç2) Then st1 = a2: Exit For
Next
rws = s1.Cells(Rows.Count, "A").End(3).Row + 1
s1.Cells(rws, "A") = x
s1.Cells(rws, "B") = Cells(Target.Row, "B")
s1.Range(s1.Cells(rws, st), s1.Cells(rws, st1)).MergeCells = True
With s1.Cells(rws, st)
.Value = CDate(Cells(Target.Row, "D"))
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -4.99893185216834E-02
End With
10:
End Sub[/SIZE]
 
PLİNT' Alıntı:
Merhaba
Ek dosyayı deneyiniz
http://s7.dosya.tc/server/cn6203/SIPARIS2.zip.html
"A: D" sütunlarından birindeki hücreye (satırdaki dört hücrede dolu olduğu halde) veri girildiğinde
aktarmayı yapacaktır.
Bilgisayar tarih formatı "dd.mm.yyyy" şeklinde olduğu varsayılarak
Mükerrer kayıt için bir ekleme yapılmadı.
Deneyin eksikliklerde, ekleme yaparız.
Kod: 
[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr1 As String
If Selection.Cells.Count <> 1 Then MsgBox "Birden fazla hücrede işlem yapılmaz": Exit Sub
If Intersect(Target, [A:D]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("A" & Target.Row & ":D" & Target.Row), "") <> 0 Then Exit Sub
If Len(Cells(Target.Row, "A")) < 12 Then Cells(Target.Row, "A").Select: _
MsgBox "Seçili hücrede en az 12 harf olmalı, işlem yapılmadı": Exit Sub
x = UBound(Split(Cells(Target.Row, "A"), Chr(10)))
If x = 0 And Cells(Target.Row, "A") <> "" Then _
MsgBox "A" & Target.Row & "hücresinde 2.satır yok, işlem yapılmadı ": Exit Sub
x = Right(Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(0)), 4)
x1 = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(1))
x2 = Left(x, 2) & "T-" & Right(x, 2) & "M"
x = x1 & ", " & x2
tr1 = Format(Cells(Target.Row, "C"), "mmm.yy")
Set s1 = Sheets("PLANLAMA ÇİZELGESİ")
cl = s1.Cells(1, Columns.Count).End(xlToLeft).Column
For n = 2 To cl + 1
If IsDate(s1.Cells(1, n)) = True Then
If Month(s1.Cells(1, n)) = Month(Cells(Target.Row, "C")) And _
Year(s1.Cells(1, n)) = Year(Cells(Target.Row, "C")) Then Exit For
End If: Next
If n > cl Then MsgBox Cells(Target.Row, "C") & "Ay-yıl 1. sayfada yok işlem yapılmadı": Exit Sub
kç = Cells(Target.Row, "C") - CDate("31.12." & Year(Cells(Target.Row, "C")) - 1)
kç = WorksheetFunction.MRound(kç / 7, 1)
For a = n To n + 3
If CDbl(Left(Trim(s1.Cells(2, a)), Len(kç))) = CDbl(kç) Then st = a: Exit For
Next
For n2 = 2 To cl + 1
If IsDate(s1.Cells(1, n2)) = True Then
If Month(s1.Cells(1, n2)) = Month(Cells(Target.Row, "D")) And _
Year(s1.Cells(1, n2)) = Year(Cells(Target.Row, "D")) Then Exit For
End If: Next
If n2 > cl Then MsgBox Cells(Target.Row, "D") & "Ay-yıl 1. sayfada yok işlem yapılmadı": Exit Sub
kç2 = Cells(Target.Row, "D") - CDate("31.12." & Year(Cells(Target.Row, "D")) - 1)
kç2 = WorksheetFunction.MRound(kç2 / 7, 1)
For a2 = n2 To n2 + 3
If CDbl(Left(Trim(s1.Cells(2, a2)), Len(kç2))) = CDbl(kç2) Then st1 = a2: Exit For
Next
rws = s1.Cells(Rows.Count, "A").End(3).Row + 1
s1.Cells(rws, "A") = x
s1.Cells(rws, "B") = Cells(Target.Row, "B")
s1.Range(s1.Cells(rws, st), s1.Cells(rws, st1)).MergeCells = True
With s1.Cells(rws, st)
.Value = CDate(Cells(Target.Row, "D"))
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -4.99893185216834E-02
End With
10:
End Sub[/SIZE]
Genişletmek için tıkla ...

Plint hocam,, ellerine emeklerine sağlık çok teşekkür ederim. Ne zamandır yazıcam fırsatım olmadı. Bir şey düzenleyip atmam gerekiyordu. Ben örnek bir dosya oluşturup kendime uyarlayabilirim sanıyordum fakat denediğimde beceremedim. Zaten olayın %90 ı bitmiş. kendi kullandığım orijinal dosyanın linkini atıyorum. Orada yapmak istediğim bir kaç şeyi not düştüm. Yine buraya da yazayım aynılarını. Kodları o şekilde düzenleyebilirsen çok ama çok mutlu olurum.

http://s7.dosya.tc/server/yasuea/SIPARIS_LISTESI.xlsx.html

SİPARİŞ NO VE DURUM ALANLARINDA AÇILIR LİSTEDEN SEÇİM YAPIYORUM

Bazı siparişler -1 , -2 diye devam ediyor.

Onları da planlama çizelgesinde yaptığım gibi belirtiyorum. Rakamları sondan değil baştan sayarak aldırabiliriz belki.

Son olarak planlama çizelgesi dinamik olduğu için tarih sağa doğru ilerleyecek. Tanımlı alan giderek artacak.

Kopyala yapıştır ile 1'den fazla hücreyi yapıştırabiliyorum. Daha önceki makro tek tek yapmamı istiyordu. Bu değişebilir mi?

Planlama çizelgesinde, teslim tarihinden geriye doğru, 8 haftanın, durumdaki renklere göre boyanması gerekiyor. O sayfadaki teslim tarihini de boyuyorum.

Durumda ilk seçim renksiz oluyor. Daha sonra ben boyuyorum. Boyalı getiremiyorum.
 
Merhaba
Ek dosyayı deneyin
"Durum" sütunundan seçim yaptığınızda ilgili sayfaya ekleyecek, aynı spariş varsa
değiştirecektir.
http://s7.dosya.tc/server/u8m9uo/SIPARIS_LISTESI.zip.html
Kod: 
[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 19 Or Target.Row = 1 Then Exit Sub
If Selection.Cells.Count <> 1 Then MsgBox "Birden fazla hücrede işlem yapılmaz": Exit Sub
If Len(Cells(Target.Row, "A")) < 12 Then Cells(Target.Row, "A").Select: _
MsgBox "Seçili hücrede en az 12 harf olmalı, işlem yapılmadı": Exit Sub
x = UBound(Split(Cells(Target.Row, "A"), Chr(10)))
If x = 0 And Cells(Target.Row, "A") <> "" Then _
MsgBox "A" & Target.Row & " hücresinde 2.satır yok, işlem yapılmadı ": Exit Sub
If IsDate(Cells(Target.Row, "R")) = False Then MsgBox "Teslim tarihi hatalı, işlem yapılmadı": Exit Sub
x = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(0))
x1 = Left(x, 12): x2 = Mid(x, 13, 4)
If IsNumeric(Replace(Trim(Split(x, x1 & x2)(1)), " ", "")) = True Then x3 = Trim(Split(x, x1 & x2)(1))
x4 = Left(x2, 2) & "T - " & Right(x2, 2) & "M"
x5 = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(1))
x = x5 & ", " & x4 & " " & x3
Set s1 = Sheets("PLANLAMA ÇİZELGESİ")
rw = s1.Cells(Rows.Count, "A").End(3).Row + 1
Set ara = s1.Range("A1:A" & rw).Find(x, , , xlWhole)
If Not ara Is Nothing Then rw = ara.Row
cl = s1.Cells(2, Columns.Count).End(xlToLeft).Column
hf = Cells(Target.Row, "R") - CDate("31.12." & Year(Cells(Target.Row, "R")) - 1)
hf = hf / 7
hf = WorksheetFunction.RoundUp(hf, 0)
For a = 6 To cl
If s1.Cells(1, a) <> "" And IsDate(s1.Cells(1, a)) = True Then yıl = Year(s1.Cells(1, a))
If CDbl(Left(s1.Cells(2, a), 2)) = hf And yıl = Year(Cells(Target.Row, "R")) Then
Exit For
End If
Next
If Not ara Is Nothing Then MsgBox s1.Name & " Sayfasında aynı spariş bulundu, değiştirilecek"
With s1.Range(s1.Cells(rw, "B"), s1.Cells(rw, cl))
.Value = ""
.MergeCells = False
.Interior.ColorIndex = xlNone
End With
s1.Cells(rw, "A") = x
s1.Cells(rw, "B") = Cells(Target.Row, "B").Value
s1.Cells(rw, "C") = Cells(Target.Row, "R").Value
s1.Cells(rw, "C").Interior.Color = Target.DisplayFormat.Interior.Color
s1.Range(s1.Cells(rw, a - 7), s1.Cells(rw, a)).MergeCells = True
s1.Range(s1.Cells(rw, a - 7), s1.Cells(rw, a)).Borders.Weight = xlMedium
s1.Cells(rw, a - 7).Interior.Color = Target.DisplayFormat.Interior.Color
s1.Cells(rw, a - 7) = Cells(Target.Row, "R")
End Sub[/SIZE]
 
PLİNT' Alıntı:
Merhaba
Ek dosyayı deneyin
"Durum" sütunundan seçim yaptığınızda ilgili sayfaya ekleyecek, aynı spariş varsa
değiştirecektir.
http://s7.dosya.tc/server/u8m9uo/SIPARIS_LISTESI.zip.html
Kod: 
[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 19 Or Target.Row = 1 Then Exit Sub
If Selection.Cells.Count <> 1 Then MsgBox "Birden fazla hücrede işlem yapılmaz": Exit Sub
If Len(Cells(Target.Row, "A")) < 12 Then Cells(Target.Row, "A").Select: _
MsgBox "Seçili hücrede en az 12 harf olmalı, işlem yapılmadı": Exit Sub
x = UBound(Split(Cells(Target.Row, "A"), Chr(10)))
If x = 0 And Cells(Target.Row, "A") <> "" Then _
MsgBox "A" & Target.Row & " hücresinde 2.satır yok, işlem yapılmadı ": Exit Sub
If IsDate(Cells(Target.Row, "R")) = False Then MsgBox "Teslim tarihi hatalı, işlem yapılmadı": Exit Sub
x = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(0))
x1 = Left(x, 12): x2 = Mid(x, 13, 4)
If IsNumeric(Replace(Trim(Split(x, x1 & x2)(1)), " ", "")) = True Then x3 = Trim(Split(x, x1 & x2)(1))
x4 = Left(x2, 2) & "T - " & Right(x2, 2) & "M"
x5 = Trim(Split(Trim(Cells(Target.Row, "A")), Chr(10))(1))
x = x5 & ", " & x4 & " " & x3
Set s1 = Sheets("PLANLAMA ÇİZELGESİ")
rw = s1.Cells(Rows.Count, "A").End(3).Row + 1
Set ara = s1.Range("A1:A" & rw).Find(x, , , xlWhole)
If Not ara Is Nothing Then rw = ara.Row
cl = s1.Cells(2, Columns.Count).End(xlToLeft).Column
hf = Cells(Target.Row, "R") - CDate("31.12." & Year(Cells(Target.Row, "R")) - 1)
hf = hf / 7
hf = WorksheetFunction.RoundUp(hf, 0)
For a = 6 To cl
If s1.Cells(1, a) <> "" And IsDate(s1.Cells(1, a)) = True Then yıl = Year(s1.Cells(1, a))
If CDbl(Left(s1.Cells(2, a), 2)) = hf And yıl = Year(Cells(Target.Row, "R")) Then
Exit For
End If
Next
If Not ara Is Nothing Then MsgBox s1.Name & " Sayfasında aynı spariş bulundu, değiştirilecek"
With s1.Range(s1.Cells(rw, "B"), s1.Cells(rw, cl))
.Value = ""
.MergeCells = False
.Interior.ColorIndex = xlNone
End With
s1.Cells(rw, "A") = x
s1.Cells(rw, "B") = Cells(Target.Row, "B").Value
s1.Cells(rw, "C") = Cells(Target.Row, "R").Value
s1.Cells(rw, "C").Interior.Color = Target.DisplayFormat.Interior.Color
s1.Range(s1.Cells(rw, a - 7), s1.Cells(rw, a)).MergeCells = True
s1.Range(s1.Cells(rw, a - 7), s1.Cells(rw, a)).Borders.Weight = xlMedium
s1.Cells(rw, a - 7).Interior.Color = Target.DisplayFormat.Interior.Color
s1.Cells(rw, a - 7) = Cells(Target.Row, "R")
End Sub[/SIZE]
Genişletmek için tıkla ...

hocam mükemmel olmuş. Allah sizden razı olsun. çok teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst