a1 hücresi doluysa

[ismailozkan4224]

selam arkadaşlar böylr kısa bir makroya ihtiyacım var. ama yazamadım
a1 hücresi doluysa b1 hücresine bugünün tarihini yaz
a1 hücresi boş ise ya da başalmış ise b1 hücresi boş olsun

 

[AdemCan]

Merhaba iki örnek kod.

Sub test()

If Sayfa1.Range("A1").Value <> "" Then
    Sayfa1.Range("B1").Value = Date
Else
    Sayfa1.Range("B1").Value = ""
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" Then
    If Target.Value <> "" Then
        Target.Offset(0, 1).Value = Date
    Else
        Target.Offset(0, 1).Value = ""
    End If
End If
End Sub

 

[Muzaffer Ali]

Merhaba.
Hangi sayfada olmasını istiyorsanız o sayfanın kod kısmına aşağıdaki kodu kopaylayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        If Range("A1") = "" Then
            Range("B1") = ""
        Else
            Range("B1") = Date
        End If
    End If
End Sub

 

[ismailozkan4224]

muzaffer ali kardeşim verdiğin kodu aşağıdaki kendi koduma entegre edemedim.ademcan kardeşim senin kodu da entegre edemedim. zahmet olmayacaksa yardımcı olabilirseniz sevinirim.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo son1



a = Sheets("VERİ").Cells(3, 2)
b = Sheets("VERİ").Cells(3, 4)
c = Sheets("VERİ").Cells(3, 1)

son1:
On Error GoTo SON
If Intersect(Target, [AA2]) Is Nothing Then Exit Sub
Cells(17, 1) = " Yukarıda açık kimlik ve diğer bilgileri yer alan " & Cells(5, 13) & " ; " & Format(Now, "dd.mm.yyyy") & " tarihine rastlayan " & Format(Now, "dddd") & " günü saat " & Format(Now, "hh:mm") & " 'da " & a & " " & b & "na gelerek “ " & c & " ” konumunda; “ " & Cells(3, 45) & " ” hakkındaki iddiaları kendisine anlatılıp sorulduğunda; cevap olarak, “ " & [AA2] & " ” dedi. Yazılanlar okundu, kendisinin okumasına fırsat verildi. Yazılanların söylediklerinin aynısı olduğunu, başka diyeceğinin bulunmadığını, ifadesinin özgür iradesine dayalı olduğunu beyan etmesi üzerine bu ifade tutanağı birlikte imzalandı. " & Cells(7, 26)
Call SAYFAYATARIHAKTAR 'Module1
Application.ScreenUpdating = False
Call KALINHARFYAPIFADE 'BU SAYFA
Call KALINHARFYAPIFADE1 'BU SAYFA
Call SATIRYUKSELIGINIAYARLAIFADE 'Module2
Call BUTTONYUKSEKLIKLERINIAYARLAIFADE 'Module3
SON:
ActiveSheet.Shapes("CommandButton1").Top = "1"
'ActiveSheet.Shapes("CommandButton1").Left = "10"
'ActiveSheet.Shapes("CommandButton1").Right = "10"
Call MESSAGEBOXAC
'Application.EnableEvents = True
Application.ScreenUpdating = True
'MsgBox "İşleminiz Tamamlanmıştır. TEBRİKLER", , "İSMAİL ÖZKAN Sıraç Aydıntaşbaş İlkokulu - " & Format(Now, "dd.mm.yyyy")
End Sub

 

[Muzaffer Ali]

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, [AA2]) Is Nothing Then
        Application.ScreenUpdating = False
        On Error GoTo son1
        a = Sheets("VERİ").Cells(3, 2)
        b = Sheets("VERİ").Cells(3, 4)
        c = Sheets("VERİ").Cells(3, 1)
        
son1:
        On Error GoTo SON
        Cells(17, 1) = " Yukarıda açık kimlik ve diğer bilgileri yer alan " & Cells(5, 13) & " ; " & Format(Now, "dd.mm.yyyy") & " tarihine rastlayan " & Format(Now, "dddd") & " günü saat " & Format(Now, "hh:mm") & " 'da " & a & " " & b & "na gelerek “ " & c & " ” konumunda; “ " & Cells(3, 45) & " ” hakkındaki iddiaları kendisine anlatılıp sorulduğunda; cevap olarak, “ " & [AA2] & " ” dedi. Yazılanlar okundu, kendisinin okumasına fırsat verildi. Yazılanların söylediklerinin aynısı olduğunu, başka diyeceğinin bulunmadığını, ifadesinin özgür iradesine dayalı olduğunu beyan etmesi üzerine bu ifade tutanağı birlikte imzalandı. " & Cells(7, 26)
        Call SAYFAYATARIHAKTAR 'Module1
        
        Call KALINHARFYAPIFADE 'BU SAYFA
        Call KALINHARFYAPIFADE1 'BU SAYFA
        Call SATIRYUKSELIGINIAYARLAIFADE 'Module2
        Call BUTTONYUKSEKLIKLERINIAYARLAIFADE 'Module3
SON:
        ActiveSheet.Shapes("CommandButton1").Top = "1"
        'ActiveSheet.Shapes("CommandButton1").Left = "10"
        'ActiveSheet.Shapes("CommandButton1").Right = "10"
        Call MESSAGEBOXAC
        'Application.EnableEvents = True
        Application.ScreenUpdating = True
        'MsgBox "İşleminiz Tamamlanmıştır. TEBRİKLER", , "İSMAİL ÖZKAN Sıraç Aydıntaşbaş İlkokulu - " & Format(Now, "dd.mm.yyyy")
    ElseIf Not Intersect(Range("A1"), Target) Is Nothing Then
        If Range("A1") = "" Then
            Range("B1") = ""
        Else
            Range("B1") = Date
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[ismailozkan4224]

code execution has been interrubted hatası veriyor. dosyam biraz büyük. 1 nolu sayfada işlem yapıyorum

 

[Muzaffer Ali]

Dosyanız ekte.
Bende hata vermedi ama başka hataları giderdim.
Ayrıca formda zaman göstermek için Do-Loop döngüsü yapmışsınız bu hiç doğru değil.
Gerçekten saate ihtiyacınız varsa forumda doğru kodları bulup uygulayın.

A1 ve B1 birleştirilmiş hücre olduğu için B1'e yaptığınız işlemi iç bir zaman göremezsiniz.
Yani yazdığımız kod hiçbir işlem yapmıyor.

 

[ismailozkan4224]

Dosyanız ekte.
Bende hata vermedi ama başka hataları giderdim.
Ayrıca formda zaman göstermek için Do-Loop döngüsü yapmışsınız bu hiç doğru değil.
Gerçekten saate ihtiyacınız varsa forumda doğru kodları bulup uygulayın.

A1 ve B1 birleştirilmiş hücre olduğu için B1'e yaptığınız işlemi iç bir zaman göremezsiniz.
Yani yazdığımız kod hiçbir işlem yapmıyor.

hakkınızı helal edin. hücre numaralarını kendime uyarlamayı unutmuşum. oruç işte..
ben onu bulabildim saat olarak. "Gerçekten saate ihtiyacınız varsa forumda doğru kodları bulup uygulayın. "bunun nedeni nedir. ayrıca nasıl bir öneriniz var bununla ilgili olarak