ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[deliolan45]

Merhaba söyle bir makro yazmak mümkün müdür acaba örnek: sayfa 1 de C sutununa yazdığım bir veriyi sayfa 2 deki C sutununa yazarak yanına 1. tarih ve saat olan tarih ve saati yazacak onun yanına ise 30 dk eklenmiş olan bir 2. tarih ve saat yazilacak (1. Tarih 17.05.2023 17.30.00 2. Tarih 17.05.2023 18.00.00) 2. Yazmış olduğumuz saat geldiğinde ise sayfa 1 ve sayfa 2 deki girmiş olduğum veriyi silecek ve bir altındaki veriyi onun yerine kaydırarak her iki sayfada. Yardımlarınız için şimdiden teşekkürler elinde herhangi bir örnek dosya olmadığı için ekleyemedim.

[CouseN]

Kod: Tümünü seç

Sub VeriKopyalaSil()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim veri As Variant, tarih1 As Date, tarih2 As Date
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long
   
    ' Sayfa 1 ve Sayfa 2'yi belirle
    Set ws1 = ThisWorkbook.Sheets("Sayfa 1")
    Set ws2 = ThisWorkbook.Sheets("Sayfa 2")
   
    ' Sayfa 1'deki son dolu satırı bul
    lastRow1 = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Row
   
    ' Veriyi ve tarihleri al
    veri = ws1.Range("C" & lastRow1).Value
    tarih1 = Now()
    tarih2 = tarih1 + TimeValue("00:30:00")
   
    ' Sayfa 2'ye veriyi ve tarihleri yaz
    lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row + 1
    ws2.Range("C" & lastRow2).Value = veri
    ws2.Range("D" & lastRow2).Value = Format(tarih1, "dd.mm.yyyy hh:mm:ss")
    ws2.Range("E" & lastRow2).Value = Format(tarih2, "dd.mm.yyyy hh:mm:ss")
   
    ' Şimdiki zamanı al
    Dim currentTime As Date
    currentTime = Now()
   
    ' Sayfa 1 ve Sayfa 2'deki veriyi ve tarihleri kontrol et
    For i = lastRow1 To 1 Step -1
        If ws1.Range("C" & i).Value <> "" Then
            Dim cellTime As Date
            cellTime = ws1.Range("D" & i).Value
            If currentTime >= cellTime Then
                ' Veriyi sil ve altındaki veriyi yukarı kaydır
                ws1.Range("C" & i).ClearContents
                For j = i To lastRow1 - 1
                    ws1.Range("C" & j).Value = ws1.Range("C" & j + 1).Value
                Next j
               
                ' Sayfa 2'deki veriyi sil ve altındaki veriyi yukarı kaydır
                For k = lastRow2 To 2 Step -1
                    ws2.Range("C" & k).Value = ws2.Range("C" & k - 1).Value
                    ws2.Range("D" & k).Value = ws2.Range("D" & k - 1).Value
                    ws2.Range("E" & k).Value = ws2.Range("E" & k - 1).Value
                Next k
                ws2.Range("C2").ClearContents
                ws2.Range("D2").ClearContents
                ws2.Range("E2").ClearContents
               
                Exit For
            End If
        End If
    Next i
End Sub


[deliolan45]

firmaları comboboxlardan seçmeyi eklemeyi 2. sayfaya atmayı yaptım ancak bir türlü zamanu geldğinde silmeyi yapamadım örnek dosya yüklesem bir baka bilirmisiniz ?

benim istediğim
2. sayfaya aktarılan değerin 4. satırda yazan (silinme zamanı ) vakit geldiğinde yanında yazan firmanın 1. ürün 2. ürün 3.ürün 4.ürün kodları altındaki satırlarda silinme zamanı gelen değer hangi ürün ise o ürünün altında değeri arayıp bularak silmesi böyle bir kod var ise yardım ede bilirmisiniz ?

[deliolan45]

örnek dosya ektedir.