bekleyen sipariş

[piyers]

Evren Gizlen
eline sağlık çok güzel buda işime yarar bir program

 

[Orion1]

İstediğinizin doğru bir şekilde olabilmesi için,Verileriniz bu yolladığım dosya ile girmelisiniz.Çünkü bu dosyada ıd numarası veriliyor ve o ıd numarasaına göre diğer sayafada bulup tarihi düzeltiyor.Aksi takdirde hatalı sonuçlar üretebilirdi.
Tarih girişinide tarih sekmesinden listeden istediğiniz,satırı seçip tarihi değiştirebilirsiniz.Listeden seçtiğiniz tarih Sayfasındaki tarihi değiştirir.
Bu dosyada bir eksiklik varsa onu yazababilirsiniz.

 

[piyers]

Evren Gizlen

bu dosyaya göre ayarlama yapacağım



saygılarımla

 

[Orion1]

Evren Gizlen

bu dosyaya göre ayarlam yapacağım

bana gönderdiğin makro ve bilgiler için size çok teşekkür ederim
ellerinize sağlık sağolun

saygılarımla

Değişiklik yapmanız gerekirse veya eklenecek bir şey olursa yazarsınız.
İyi çalışmalar.
Hatırlatma : Dosyaya verilerinizi UserformDan giriniz.

 

[piyers]

yardım

Evren arkadaş

selam sizden bir ricam olacak ekteki dosyayı kullanmaya karar verdik ama bekleyen siparişler bolumundeki tarih kısmına tarihi yazım butona basınca
bilgileri makina 1 ise makina 1 e makina 2 ise makina 2 atıyor ama bekleyen siparişler de o attığı satırlar kalıyor sizden ricam butona bastığım zaman tarih yazan satırları atsın tarih yazmayan satırları atmasın bu makroyu bana gönderirseniz sevinirim.

saygılarımla

 

[Orion1]

Sayfalara atılan satırlar Bekleyenler sayfasından silinsinmi istiyorsunuz?

 

[piyers]

evet bekleyen siparişler de silinsin istiyorum

 

[Orion1]

evet bekleyen siparişler de silinsin istiyorum

Dosyanız hazır.

Sub aktar()
Dim sat As Long, i As Long, k As Integer
Sheets("BEKLEYEN SİPARİŞLER").Select
Application.ScreenUpdating = False
For i = Cells(65536, "B").End(xlUp).Row To 6 Step -1
    If Left(LCase(Replace(Replace(Trim(Cells(i, "L").Value), "I", "I"), "İ", "i")), 6) = "makina" Then
        On Error GoTo atla
        adr1 = Range(Cells(i, "B"), Cells(i, "L")).Address
        sat = Sheets(Cells(i, "L").Value).Cells(65536, "B").End(xlUp).Row + 1
        adr2 = Range(Cells(sat, "B"), Cells(sat, "L")).Address
        Sheets(Cells(i, "L").Value).Range(adr2).Value = Range(adr1).Value
        Range(adr1).Delete (xlUp)
atla:
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[piyers]

Evren ArkadaŞ
Tarİh GİrmedİĞİm Satirlarida GÖnderİyor
Tarİh GİrmedİĞİm Satirlar Gİtmesİn

 

[Orion1]

Evren ArkadaŞ
Tarİh GİrmedİĞİm Satirlarida GÖnderİyor
Tarİh GİrmedİĞİm Satirlar Gİtmesİn

Dosyanız hazır.

Sub aktar()
Dim sat As Long, i As Long, k As Integer
Sheets("BEKLEYEN SİPARİŞLER").Select
Application.ScreenUpdating = False
For i = Cells(65536, "B").End(xlUp).Row To 6 Step -1
    If Cells(i, "K").Value = "" Then GoTo atla
    If Left(LCase(Replace(Replace(Trim(Cells(i, "L").Value), "I", "I"), "İ", "i")), 6) = "makina" Then
        On Error GoTo atla
        adr1 = Range(Cells(i, "B"), Cells(i, "L")).Address
        sat = Sheets(Cells(i, "L").Value).Cells(65536, "B").End(xlUp).Row + 1
        adr2 = Range(Cells(sat, "B"), Cells(sat, "L")).Address
        Sheets(Cells(i, "L").Value).Range(adr2).Value = Range(adr1).Value
        Range(adr1).Delete (xlUp)

    End If
atla:
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[piyers]

TEŞEKKÜR EDERİM
güzel odu eline sağlık

 

[Orion1]

TEŞEKKÜR EDERİM
güzel odu eline sağlık

Rica ederim.
iyi çalışmalar.

 

[piyers]

bir konuda daha yardımcı olanızı isterim

evren arkadaş
sizden bir ricam olacak
ben bir kayan yazı makrosunu düzeltmek istiyorum yardımcı olursanız sevinirim
makroyu çalıştırarak çalısıyor ben ekcel sayfasını açtığım zaman çalışsın
yani makroyu hangi sayfa için yapmışsam o sayfayı acınca çalışsın dirkt olark

bunu ayarlaya bilirmisiniz

teşekkürler

 

[Orion1]

Dosyanız hazır.

 

[piyers]

evren arkadaş
sizden bir ricam olacak
sizede cok yüklendik ama

size ekte bir dosya gönderdim
bakarsanız sevinirim.

saygılarımla

 

[Orion1]

evren arkadaş
sizden bir ricam olacak
sizede cok yüklendik ama

size ekte bir dosya gönderdim
bakarsanız sevinirim.

saygılarımla

Dosyanız hazır Makina adı bölümüne x işaretini ilgili makinanın yanındaki hücreye koymayı unutmayınız..

Sub makina_aktar()
Dim sat As Long
Sheets("SİPARİŞ FORMU").Select
Set s2 = Sheets("BEKLEYEN SİPARİŞLER")
sat = s2.Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "BEKLEYEN SİPARİŞLER SAYFASI Satırları doldu.." & vbLf & _
    "Başka kayıt yapamazsınız..!!", vbCritical, "DİKKAT"
End If
For k = 3 To 9 Step 6
    If Cells(8, k).Value = "" Or Cells(10, k).Value = "" Or Cells(33, k).Value _
    = "" And Cells(33, k + 2).Value = "" Then
        MsgBox Cells(8, k).Address & " Adresinde veya " & _
        vbLf & Cells(10, k).Address & " Adresindeki hücreler boş olduğundan " _
        & "YADA MAKİNA ismi seçilmediğinden Dolayı..!!" & _
        vbLf & k & " sütünundaki veriler kayıt edilmedi..!!", vbCritical, "DİKKAT"
        GoTo atla
    End If
    s2.Cells(sat, "B").Value = Cells(10, k).Value
    s2.Cells(sat, "C").Value = Cells(12, k).Value
    s2.Cells(sat, "D").Value = Cells(18, k).Value
    s2.Cells(sat, "E").Value = Cells(20, k).Value
    s2.Cells(sat, "F").Value = Cells(22, k).Value
    s2.Cells(sat, "G").Value = Cells(24, k).Value
    s2.Cells(sat, "H").Value = Cells(26, k).Value
    s2.Cells(sat, "K").Value = Cells(8, k).Value
    If Cells(33, k).Value = "X" Or Cells(33, k).Value = "x" Then
        s2.Cells(sat, "L").Value = Cells(33, k - 1).Value
        ElseIf Cells(33, k + 2).Value = "X" Or Cells(33, k + 2).Value = "x" Then
        s2.Cells(sat, "L").Value = Cells(33, k + 1).Value
    End If
    Range(Cells(8, k), Cells(30, k)) = Empty
    Range(Cells(36, k + 1), Cells(43, k + 1)) = Empty
    sat = sat + 1
atla:
Next
MsgBox "Kayıt Girldi..!!", vbOKOnly + vbInformation, Application.UserName
Set s2 = Nothing
End Sub

 

[piyers]

açıklama dosyada

 

[piyers]

Evren Gizlen

dosyayı ekledim açıkla dosyada

bekleyen siparişler sayfasına gönderildiği zaman bu sayfada tarih ve makina bolumu boş kalsın

saygılarımla

 

[Orion1]

Evren Gizlen

dosyayı ekledim açıkla dosyada

bekleyen siparişler sayfasına gönderildiği zaman bu sayfada tarih ve makina bolumu boş kalsın

saygılarımla

Dosyanız hazır.

Sub makina_aktar()
Dim sat As Long
Sheets("SİPARİŞ FORMU").Select
Set s2 = Sheets("BEKLEYEN SİPARİŞLER")
sat = s2.Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "BEKLEYEN SİPARİŞLER SAYFASI Satırları doldu.." & vbLf & _
    "Başka kayıt yapamazsınız..!!", vbCritical, "DİKKAT"
    Set s2 = Nothing
    Exit Sub
End If
    If Cells(10, "C").Value = "" Then
        MsgBox "Firma adı boş olamaz..!!" & _
        vbLf & " Veriler kayıt edilmedi..!!", vbCritical, "DİKKAT"
        Range("C10").Select
        Set s2 = Nothing
        Exit Sub
    End If
    s2.Cells(sat, "B").Value = Cells(10, "C").Value
    s2.Cells(sat, "C").Value = Cells(12, "C").Value
    s2.Cells(sat, "D").Value = Cells(18, "C").Value
    s2.Cells(sat, "E").Value = Cells(20, "C").Value
    s2.Cells(sat, "F").Value = Cells(22, "C").Value
    s2.Cells(sat, "G").Value = Cells(24, "C").Value
    s2.Cells(sat, "H").Value = Cells(26, "C").Value
    Range(Cells(8, "C"), Cells(30, "C")) = Empty
    Range(Cells(36, "D"), Cells(43, "D")) = Empty
MsgBox "Kayıt Girildi..!!", vbOKOnly + vbInformation, Application.UserName
Set s2 = Nothing
End Sub

 

[piyers]

teşekür ederim