• DİKKAT

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

Sıra no verme hücre değişikliğinde

M

mukoli

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [H2:H1000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False

If Target.Value = "AYRILDI" Then
cevap = MsgBox("KAYIT TAŞINAÇAK.ONAYLIYOR MUSUNUZ ?", vbYesNo + vbQuestion, "UYARI", 500, 50) = vbNo

If cevap = True Then
Target.Value = ""
MsgBox "İŞLEM İPTAL EDİLDİ,YENİDEN DURUM BELİRLEYİNİZ", vbInformation
 
   
   
   Exit Sub
    End If
    a = Target.Row: Son = Sheets("İşten Ayrılanlar").Cells(65355, "A").End(3).Row + 1
Sheets("İşten Ayrılanlar").Range("B" & Son) = ActiveSheet.Range("B" & a)
Sheets("İşten Ayrılanlar").Range("C" & Son) = ActiveSheet.Range("C" & a)
Sheets("İşten Ayrılanlar").Range("D" & Son) = ActiveSheet.Range("D" & a)
Sheets("İşten Ayrılanlar").Range("E" & Son) = ActiveSheet.Range("E" & a)
Sheets("İşten Ayrılanlar").Range("F" & Son) = ActiveSheet.Range("F" & a)
Sheets("İşten Ayrılanlar").Range("G" & Son) = ActiveSheet.Range("G" & a)
Sheets("İşten Ayrılanlar").Range("H" & Son) = ActiveSheet.Range("H" & a)
Sheets("İşten Ayrılanlar").Range("A2:A600").ClearContents
For t = 2 To Son
If Not Sheets("İşten Ayrılanlar").Cells(t, 2) = "" Then
sr = sr + 1
Sheets("İşten Ayrılanlar").Cells(t, 1) = sr
End If
Next t
Sheets("İşten Ayrılanlar").Range("A2" & ":" & "H" & Son).Borders.LineStyle = xlContinuous

ActiveSheet.Rows(a).Delete
ActiveSheet.Range("A2:A600").ClearContents
son1 = ActiveSheet.Cells(65355, "B").End(3).Row + 1
For s = 2 To son1
If Not ActiveSheet.Cells(s, 2) = "" Then
Nr = Nr + 1
ActiveSheet.Cells(s, 1) = Nr
End If
Next s
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM"
End If

End Sub

Merhaba bu kod B alanıına veri girildiğinde otomatik A sütununda sıra numarası nasıl verdirebiliriz.Satır silindiğinde sırayı otomatik düzeltmesi lazım İyi günler dilerim herkese
 
İşten Ayrılanlarlar sayfasında mı olacak bu düzenleme işi?
 
C++: 
For s = 2 To son1
    If Not ActiveSheet.Cells(s, 2) = "" Then
        Nr = Nr + 1
        ActiveSheet.Cells(s, 1) = Nr
    End If
Next s
Kodunuzun bu kısmı o işi yapmıyor mu?
 
ActiveSheet ile ilgili yeni veri eklediğiniz kdo satırını ben göremiyorum.
 
Ben anlayamadım. Kusura bakmayın.
 
Hocam şöyle anlatayım bu kodu yukardaki koda entegre edebilirmiyiz
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:C201]) Is Nothing Then Exit Sub
Dim i As Long, sr As Long
[a2:a65536].ClearContents
For i = 2 To [B201:C201].End(3).Row
If Not Cells(i, 2) = "" And Not Cells(i, 3) = "" Then
sr = sr + 1
Cells(i, 1) = sr
End If
Next
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst