Tekrarlanan koduları, tek kod olarak yazmak

[ynmcan]

Merhaba arkadaşlar;

Vardiya servisi programı yapmaktayım.

Combobox1 ile seçtiğim personel bilgilerini ilgili Textboxlara (5 adet) aktarmaktayım.

Kaydet butonuyla textboxlardaki personel bilgilerini, Combobox2 de seçtiğim servis numarasına göre Vardiya1 sayfasındaki ilgili servis çizelgesine aktarıp sıra numarası vermekteyim.

Aktarma ve sıra numarası için Combobox2 de seçtiğim her servis numarası için aynı kodu If – Then yapısı ile aşağıdaki gibi kullanmaktayım.

If UserForm1.ComboBox2.Value = 1 Then

sat = ActiveSheet.Cells(36, "C").End(xlUp).Row + 1

'aktarma kodu
For i = 1 To 5
ActiveSheet.Cells(sat, i + 2).Value = UserForm1.Controls("Textbox" & i).Value
Next i

'sıra numarası kodu
With ActiveSheet.Range("B6:B36")
.Formula = "=IF(C6<>"""",MAX($B$5:B5)+1,"""")": .Value = .Value
End With

End If

20 servis (servisler çoğalabilir) için bu kodları hücre referanslarını değiştirerek tek tek yamaktayım.

Bu işlemi aktarma ve sıra numarası için birer kod ile yapabilir miyiz?

Her servis çizelgesi arası +34 satır.

Örnek dosyam ekte

 

[veyselemre]

Private Sub CommandButton1_Click()

    Dim servis, basSat
    servis = UserForm1.ComboBox2.Value

    If servis > 0 And servis < 21 Then
        basSat = (servis - 1) * 34 + 6
        sat = ActiveSheet.Cells(basSat + 30, "C").End(xlUp).Row + 1

        For i = 1 To 5
            ActiveSheet.Cells(sat, i + 2).Value = UserForm1.Controls("Textbox" & i).Value
        Next i

        With ActiveSheet.Range("B" & basSat).Resize(31)
            .Formula = "=IF(" & .Cells(1).Offset(, 1).Address(0, 0) & "<>"""",MAX(" & .Cells(1).Offset(-1).Address & ":" & .Cells(1).Offset(-1).Address(0, 0) & ")+1,"""")"
            .Value = .Value
        End With

    End If

End Sub

 

[ynmcan]

Private Sub CommandButton1_Click()

    Dim servis, basSat
    servis = UserForm1.ComboBox2.Value

    If servis > 0 And servis < 21 Then
        basSat = (servis - 1) * 34 + 6
        sat = ActiveSheet.Cells(basSat + 30, "C").End(xlUp).Row + 1

        For i = 1 To 5
            ActiveSheet.Cells(sat, i + 2).Value = UserForm1.Controls("Textbox" & i).Value
        Next i

        With ActiveSheet.Range("B" & basSat).Resize(31)
            .Formula = "=IF(" & .Cells(1).Offset(, 1).Address(0, 0) & "<>"""",MAX(" & .Cells(1).Offset(-1).Address & ":" & .Cells(1).Offset(-1).Address(0, 0) & ")+1,"""")"
            .Value = .Value
        End With

    End If

End Sub

Veysel Bey teşekkür ederim. İşimi kolaylaştırdınız. Emeğinize salık