ŞARTA BAĞLI OTOMATİK KAYIT NUMARASI

[demir94]

Merhaba,

Excelde verileri girdiğim bir new_project sayfası ve bu kayıtların tutulduğu all_projects sayfası var. new_project sayfasına girdiğim bilgileri all_projects sayfasına kopyalatıyorum. new_project sayfasında 3 tane sütunda bilgi girişi yapıyorum. Bunları all_projects'te tek bir satıra sırayla yazdırıyorum.


Kodum şu şekilde:

Sub Kaydet()

Dim i As Double

If all_projects.Range("A2") = "" Then

i = 2

Else

i = all_projects.Range("A1").End(xlDown).Row + 1

End If


'hangi döngüye ekleme yapılırsa o ve ondan sonraki döngülerdeki = den önceki ilave edilen sayılar,
'eklenen bilgi sayısı kadar artırılır.
'en sondaki temizleme komutları da eklenen sütuna göre artırılır.


For k = 1 To 11 'ilk sütunun döngüsü

all_projects.Cells(i, k + 3) = new_project.Cells(k + 1, 3)

Next k



For m = 1 To 10 'ikinci sütunun döngüsü


all_projects.Cells(i, m + 14) = new_project.Cells(m + 1, 6)

Next m



For n = 1 To 10 'üçüncü sütunun döngüsü


all_projects.Cells(i, n + 24) = new_project.Cells(n + 1, 9)

Next n


Range("C2:C12").ClearContents
Range("F2:F11").ClearContents
Range("I2:I11").ClearContents
ActiveSheet.Cells(2, 3).Select

End Sub

Sorunum şu:
Örneğin new_project sayfasındaki C2 hücresini all_projects sayfasında D sütununun en altına kopyalıyor. Bu kopyalanan değer proje kodu. Ancak burada yeni bir özellik eklemek istiyorum. Eğer C2 hücresinde proje kodu yerine "SOSYAL SORUMLULUK" yazarsam kopyalama işleminde sadece C2 hücresini all_projects sayfasındaki D sütununun sonuna yapıştırmak yerine excel bir şarta göre kendi bir kod versin istiyorum. Sosyal sorumluluk için üretilecek proje kodu YIL-SSP-00x (Örnek: 2015-SSP-005) şeklinde olacak. Yeni kayıta all_projects sayfasında D sütununda en son yazan (en altta olmayabilir çünkü bu sitile uymayan başka proje kodları da aynı sütuna yazılıyor.) 2015-SSP-005 değerinden bir büyüğünü verdirmeliyim. Yeni yıla geçildiyse ve ilk defa sosyal sorumluluk projesi kaydedeceksem örneğin 2016-SSP-001 yazmalı. all_projects sayfasında bu kod bilgisini bulmak zorsa eğer bu proje kodlu kayıtların F sütununda "Sosyal Sorumluluk Projesi" yazıyor. Aramak için o da kullanılabilir. Tarih bilgisi new_project sayfasında "C11" hücresinde bulunuyor. Yıl verisini almak için burası kullanılabilir. Bir de ek olarak all_projects sayfasında yani satırı doldururken F sütununa "Sosyal Sorumluluk Projesi" yazsın istiyorum. Bunları nasıl buldurup tanımlatacağım bilemedim. Yardımcı olursanız çok sevinirim.

 

[muhasebeciyiz]

Sub Kaydet()

    Dim i As Long
    Dim wsNew As Worksheet
    Dim wsAll As Worksheet
    Dim projKod As String
    Dim yil As String
    Dim maxKod As Long
    Dim cell As Range
    Dim tarih As Date
    Dim sosyalFlag As Boolean
    Dim k As Long, m As Long, n As Long
    
    Set wsNew = Sheets("PROJE KAYIT")
    Set wsAll = Sheets("TÜM PROJELER")
    
    If wsAll.Range("A2") = "" Then
        i = 2
    Else
        i = wsAll.Cells(wsAll.Rows.Count, "A").End(xlUp).Row + 1
    End If
    
    If wsNew.Range("C2").Value = "SOSYAL SORUMLULUK" Then
        sosyalFlag = True
        tarih = wsNew.Range("C11").Value
        yil = Year(tarih)

        maxKod = 0
        For Each cell In wsAll.Range("D2:D" & wsAll.Cells(wsAll.Rows.Count, "D").End(xlUp).Row)
            If cell.Value Like yil & "-SSP-###" Then
                Dim parca() As String
                parca = Split(cell.Value, "-")
                If UBound(parca) = 2 Then
                    If CLng(parca(2)) > maxKod Then
                        maxKod = CLng(parca(2))
                    End If
                End If
            End If
        Next cell

        projKod = yil & "-SSP-" & Format(maxKod + 1, "000")
        wsAll.Cells(i, 4).Value = projKod
        wsAll.Cells(i, 6).Value = "Sosyal Sorumluluk Projesi"
    Else
        sosyalFlag = False
        wsAll.Cells(i, 4).Value = wsNew.Range("C2").Value
    End If
    
    For k = 1 To 11
        If Not (sosyalFlag And k = 1) Then
            wsAll.Cells(i, k + 3).Value = wsNew.Cells(k + 1, 3).Value
        End If
    Next k
   
    For m = 1 To 10
        wsAll.Cells(i, m + 14).Value = wsNew.Cells(m + 1, 6).Value
    Next m
    
    For n = 1 To 10
        wsAll.Cells(i, n + 24).Value = wsNew.Cells(n + 1, 9).Value
    Next n
    
    wsNew.Range("C2:C12").ClearContents
    wsNew.Range("F2:F11").ClearContents
    wsNew.Range("I2:I11").ClearContents
    
    wsNew.Cells(2, 3).Select

    MsgBox "Proje başarıyla kaydedildi!", vbInformation

End Sub

Açıklamalar

C2 hücresinde "SOSYAL SORUMLULUK"** yazıyorsa: Kod üretir, örn. 2025-SSP-001`
Veriler:

• C2:C12 → D:N
• F2:F11 → O:X
• I2:I11 → Y:AH

C2 hücresindeki "SOSYAL SORUMLULUK" yazısı, özel kod üretimi sonrası tekrar üzerine yazılmaz.
Girişler temizlenir ve kullanıcıya bilgi verilir.

Denermisiniz

 

[demir94]

Yanıtınız için teşekkür ederim ama kod gelmiyor. Yine C2 hücresinde yazan "SOSYAL SORUMLULUK" all_projects!D sütununa yapışıyor.
Kod bayağı güzel benziyor elinize sağlık ama bir yerine birşey eklemek gerekiyor sanırım.

Bir de
" Set wsNew = Sheets("new_project")
Set wsAll = Sheets("all_projects") " Bu haliyle çalışmadı kod.

Şu kısmı böyle güncelledim. VBA tarafındaki değil de excelde görünen isim değerlerini kullanmışsınız sanırım.
Set wsNew = Sheets("PROJE KAYIT")
Set wsAll = Sheets("TÜM PROJELER")

 

[muhasebeciyiz]

Revize kodu tekrar denermisiniz

 

[demir94]

Harika kod geldi Ama bir önceki seferde "Sosyal Sorumluluk Projesi" F sütununa gelmişti. Şimdi yazmıyor.

 

[muhasebeciyiz]

"Sosyal Sorumluluk Projesi" metnini döngüden sonra yaz
wsAll.Cells(i, 4).Value = projKod

Ve en sona (döngülerden sonra) şu satırı ekleyin:
If sosyalFlag Then
wsAll.Cells(i, 6).Value = "Sosyal Sorumluluk Projesi"
End If


Makronu kısa parça halindeki durumu aşağıdaki şekilde olacak.

If wsNew.Range("C2").Value = "SOSYAL SORUMLULUK" Then
    sosyalFlag = True
    tarih = wsNew.Range("C11").Value
    yil = Year(tarih)

    maxKod = 0
    For Each cell In wsAll.Range("D2:D" & wsAll.Cells(wsAll.Rows.Count, "D").End(xlUp).Row)
        If cell.Value Like yil & "-SSP-###" Then
            Dim parca() As String
            parca = Split(cell.Value, "-")
            If UBound(parca) = 2 Then
                If CLng(parca(2)) > maxKod Then
                    maxKod = CLng(parca(2))
                End If
            End If
        End If
    Next cell

    projKod = yil & "-SSP-" & Format(maxKod + 1, "000")
    wsAll.Cells(i, 4).Value = projKod
Else
    sosyalFlag = False
    wsAll.Cells(i, 4).Value = wsNew.Range("C2").Value
End If

For k = 1 To 11
    If Not (sosyalFlag And k = 1) Then
        wsAll.Cells(i, k + 3).Value = wsNew.Cells(k + 1, 3).Value
    End If
Next k

For m = 1 To 10
    wsAll.Cells(i, m + 14).Value = wsNew.Cells(m + 1, 6).Value
Next m

For n = 1 To 10
    wsAll.Cells(i, n + 24).Value = wsNew.Cells(n + 1, 9).Value
Next n

If sosyalFlag Then
    wsAll.Cells(i, 6).Value = "Sosyal Sorumluluk Projesi"
End If

 

[demir94]

Teşekkür ederim elinize sağlık. Şimdi çok iyi çalışıyor