• DİKKAT

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

Hücre değerine göre makro çalıştırma !...

Katılım
24 Aralık 2016
Mesajlar
27
Excel Vers. ve Dili
2010 tr
Merhaba
İlköncelikle yol gösteren yardımcı olan yada olmaya e teşekkür etmek isterim.
benim sorunum şu j10 hücresine + koydugumda c10:ı10 arasındaki verileri ARŞİV sayfasına aktarsın ve alt alta bu sürekli devam etsin tabi + koydugum hücreler yardımcı olursanız çok sevinirim
iyi çalışmalar dilerim...
 

Ekli dosyalar

"Satışlar" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın. (Var olan kodu silebilirsiniz.)

Mükerrer aktarımı önlemek için "AA" sütununa "OK" yazmaktadır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [D10:D1048576]) Is Nothing Then
        Cells(Target.Row, "C") = Format(Now, "dd.mm.yyyy")
    End If
    If Not Intersect(Target, [J10:J1048576]) Is Nothing Then
        Son = Sheets("Arşiv").Range("G:N").Find(What:="*", After:=Sheets("Arşiv").Range("G7"), SearchDirection:=xlPrevious).Row + 1
        If Target = "+" And Cells(Target.Row, "AA") = "" Then
            Sheets("Arşiv").Range("G" & Son & ":M" & Son).Value = Range("C" & Target.Row & ":I" & Target.Row).Value
            Cells(Target.Row, "AA") = "OK"
        End If
    End If
End Sub
 
Merhaba.

Alternatif olsun.

Ben de aktarılan satır için T sütununa AKTARILDI yazdırmayı,
uygulama kapsamını satır bakımından sınırlandırmak için de D sütunundaki son dolu satırı esas almayı ve
Select Case yöntemiyle de aktarım ve tarih yazdırma işlemini kodlamıştım.
(Aşağıdaki kodun da doğal olarak, Satışlar sayfasının kod bölümündeki mevcut kod yerine kullanılması gerekiyor).
Kod:
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Target.Row > Cells([D1048576].End(3).Row, "D").End(3).Row Then Exit Sub
Select Case Target.Column
    Case Is = 4: Cells(Target.Row, "C") = Format(Now, "dd.mm.yyyy")
    Case Is = 10
        If Target = "+" Then
[COLOR="Red"]            If Cells(Target.Row, "T") = "AKTARILDI" Then
                MsgBox Target.Row & ". satır daha önce aktarılmıştı..": Exit Sub: End If
            Cells(Target.Row, "T") = "AKTARILDI"[/COLOR]
            arsat = Sheets("Arşiv").Cells(Sheets("Arşiv").[G1048576].End(3).Row, "G").End(3).Row + 1
                For sut = 3 To 9
                    Sheets("Arşiv").Cells(arsat, sut + 4) = Cells(Target.Row, sut)
                Next
        End If
[B][COLOR="Blue"]        Range("[COLOR="Red"]C[/COLOR]" & Target.Row & ":[COLOR="red"]J[/COLOR]" & Target.Row).Delete Shift:=xlUp[/COLOR][/B]
    Case Else: Exit Sub
End Select
[B]End Sub[/B][/FONT]
 
Teşekkür ederim

"Satışlar" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın. (Var olan kodu silebilirsiniz.)

Mükerrer aktarımı önlemek için "AA" sütununa "OK" yazmaktadır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [D10:D1048576]) Is Nothing Then
        Cells(Target.Row, "C") = Format(Now, "dd.mm.yyyy")
    End If
    If Not Intersect(Target, [J10:J1048576]) Is Nothing Then
        Son = Sheets("Arşiv").Range("G:N").Find(What:="*", After:=Sheets("Arşiv").Range("G7"), SearchDirection:=xlPrevious).Row + 1
        If Target = "+" And Cells(Target.Row, "AA") = "" Then
            Sheets("Arşiv").Range("G" & Son & ":M" & Son).Value = Range("C" & Target.Row & ":I" & Target.Row).Value
            Cells(Target.Row, "AA") = "OK"
        End If
    End If
End Sub

konu direk çözüldü çok teşekkür ederim....
 
Teşekkür ederim

Merhaba.

Alternatif olsun.

Ben de aktarılan satır için T sütununa AKTARILDI yazdırmayı,
uygulama kapsamını satır bakımından sınırlandırmak için de D sütunundaki son dolu satırı esas almayı ve
Select Case yöntemiyle de aktarım ve tarih yazdırma işlemini kodlamıştım.
(Aşağıdaki kodun da doğal olarak, Satışlar sayfasının kod bölümündeki mevcut kod yerine kullanılması gerekiyor).
Kod:
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Target.Row > Cells([D1048576].End(3).Row, "D").End(3).Row Then Exit Sub
Select Case Target.Column
    Case Is = 4: Cells(Target.Row, "C") = Format(Now, "dd.mm.yyyy")
    Case Is = 10
        If Target = "+" Then
            If Cells(Target.Row, "T") = "AKTARILDI" Then
                MsgBox Target.Row & ". satır daha önce aktarılmıştı..": Exit Sub: End If
            Cells(Target.Row, "T") = "AKTARILDI"
            arsat = Sheets("Arşiv").Cells(Sheets("Arşiv").[G1048576].End(3).Row, "G").End(3).Row + 1
                For sut = 3 To 9
                    Sheets("Arşiv").Cells(arsat, sut + 4) = Cells(Target.Row, sut)
                Next
        End If
    Case Else: Exit Sub
End Select
[B]End Sub[/B][/FONT]

aktarıldı yazısınıda denedim gerçekten başarılı bir çalışma olmuş çok teşekür ederim sağolun...
 
Peki buna satırı taşıdıktan sonra satışlar sayfasından silmesini ve boşalan satırı kaldırmasını ekleyebilirmiyiz???
 
bir soru daha sorsam ?

Merhaba.

Alternatif olsun.

Ben de aktarılan satır için T sütununa AKTARILDI yazdırmayı,
uygulama kapsamını satır bakımından sınırlandırmak için de D sütunundaki son dolu satırı esas almayı ve
Select Case yöntemiyle de aktarım ve tarih yazdırma işlemini kodlamıştım.
(Aşağıdaki kodun da doğal olarak, Satışlar sayfasının kod bölümündeki mevcut kod yerine kullanılması gerekiyor).
Kod:
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Target.Row > Cells([D1048576].End(3).Row, "D").End(3).Row Then Exit Sub
Select Case Target.Column
    Case Is = 4: Cells(Target.Row, "C") = Format(Now, "dd.mm.yyyy")
    Case Is = 10
        If Target = "+" Then
            If Cells(Target.Row, "T") = "AKTARILDI" Then
                MsgBox Target.Row & ". satır daha önce aktarılmıştı..": Exit Sub: End If
            Cells(Target.Row, "T") = "AKTARILDI"
            arsat = Sheets("Arşiv").Cells(Sheets("Arşiv").[G1048576].End(3).Row, "G").End(3).Row + 1
                For sut = 3 To 9
                    Sheets("Arşiv").Cells(arsat, sut + 4) = Cells(Target.Row, sut)
                Next
        End If
    Case Else: Exit Sub
End Select
[B]End Sub[/B][/FONT]

1 düzeltme rica edicem kardeşim satışlardan bilgileri alıp arşive attıktan sonra satışlardaki aktarılan bilgiler silinsin tabi silindikten sonra satış boş kalmasın silinebilir..
 
Gönderdiğim kod cevabını güncelledim.
Sayfayı yenileyerek kontrol edin.
Kırmızı renklendirdiğim satırları silin, mavi renkli satırı ekleyin tamamdır.

Mavi satırdaki hangi sütundan hangi sütuna kadarki kısmın silineceğini belirten sütun harflerini,
istediğiniz duruma göre değiştirebilirsiniz.
Ben C:J sütunu diye düşündüm.
.
 
hata var

Gönderdiğim kod cevabını güncelledim.
Sayfayı yenileyerek kontrol edin.
Kırmızı renklendirdiğim satırları silin, mavi renkli satırı ekleyin tamamdır.

Mavi satırdaki hangi sütundan hangi sütuna kadarki kısmın silineceğini belirten sütun harflerini,
istediğiniz duruma göre değiştirebilirsiniz.
Ben C:J sütunu diye düşündüm.
.

teşekkür ederim ilgin için kardeşim son 1 sorum olucak tabi sanada zahmet olmazsa yeni exel atıyorum giriş te 3 alan var bayi yazdım müşteri adı yazdım karı yazdıktan sonra entere bastıgımda bayi adı zarif se bilgileri aynı şekilde zarif sayfasına değilse satış sayfasına aktarılsın ve bilgiler silinsin yeni giriş için yani tekrar bayi hücresinde yazılacak yerde olsun klavye...desteğin için teşekkür ederim gerçekten...
 
Son düzenleme:
Geri
Üst