بروز رسانی شماره سطر در اکسل

[سهیل نصرت آبادی1]

سلام

اگر به عنوان مثال 10 تا ردیف داشته باشم و مثلا ردیف 8 رو پاک کنم شماره ردیف ها اتوماتیک بروز رسانی میشه یا اگر بین ردیفها سطری و اضاف کنم باز هم اتوماتیک شماره سطرها بروز رسانی میشه که کدش در ستون a2 نوشته شده اما همین کارو با زبان برنامه نویسی میخواستم امکانش هست؟؟؟؟ ممنونم

[M_ExceL]

سلام

اگر به عنوان مثال 10 تا ردیف داشته باشم و مثلا ردیف 8 رو پاک کنم شماره ردیف ها اتوماتیک بروز رسانی میشه یا اگر بین ردیفها سطری و اضاف کنم باز هم اتوماتیک شماره سطرها بروز رسانی میشه که کدش در ستون a2 نوشته شده اما همین کارو با زبان برنامه نویسی میخواستم امکانش هست؟؟؟؟ ممنونم

سلام

[COLOR=#000000][FONT=&quot]Sub Worksheet_Change(ByVal Target As Range)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]Application. EnableEvents = False[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]On Error Resume Next
    If Target.Column = 2 And Target.Offset(0, -1).Value = "" Then
        Target.Offset(0, -1).FormulaR1C1 = "=ROW()-1"
    ElseIf Target.Column = 2 And Target.Offset(0, -1).IsEmpty = "TRUE" Then
        Target.Offset(0, -1).ClearContents
    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]End Sub[/FONT][/COLOR]

فایل اکسل

[Amir Ghasemiyan]

سلام

[COLOR=#000000][FONT=&amp]Sub Worksheet_Change(ByVal Target As Range)[/FONT][/COLOR]
[COLOR=#000000][FONT=&amp]Application. EnableEvents = False[/FONT][/COLOR]
[COLOR=#000000][FONT=&amp]On Error Resume Next
    If Target.Column = 2 And Target.Offset(0, -1).Value = "" Then
        Target.Offset(0, -1).FormulaR1C1 = "=ROW()-1"
    ElseIf Target.Column = 2 And Target.Offset(0, -1).IsEmpty = "TRUE" Then
        Target.Offset(0, -1).ClearContents
    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&amp]Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#000000][FONT=&amp]End Sub[/FONT][/COLOR]

فایل اکسل

به نظر مياد كدتون ناقص باشه دوست عزيز
نياز به يك حلقه هست كه همه ستون رو بررسي كنه

[M_ExceL]

به نظر مياد كدتون ناقص باشه دوست عزيز
نياز به يك حلقه هست كه همه ستون رو بررسي كنه

سلام جناب قاسمیان
بله این کد در واقع ستون دوم رو در نظر میگیره، روش کار میکنم ببینم چی میشه
شما هم اگر امکانش بود کد رو اصلاح بفرمایید ...
با تشکر

[Amir Ghasemiyan]

این کدی هست که من پیشنهاد میکنم دوست عزیز

هرچند که پیشنهاد میکنم کارهایی که با توابع اکسل میشه انجام داد رو با کدنویسی انجام ندید. در حجم بالا روی سرعت کار بسیار موثر هست

Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
If Target.Column = 2 Then
    Lrow = Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To Lrow
        s = Cells(i, 2).Value
        If Cells(i, 2).Value <> "" Then
            Cells(i, 2).Offset(0, -1) = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(i - 1, 1))) + 1
        Else: Cells(i, 2).Offset(0, -1) = ""
        End If
    Next i
End If
Application.EnableEvents = True
End Sub

[M_ExceL]

این کدی هست که من پیشنهاد میکنم دوست عزیز

هرچند که پیشنهاد میکنم کارهایی که با توابع اکسل میشه انجام داد رو با کدنویسی انجام ندید. در حجم بالا روی سرعت کار بسیار موثر هست

Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
If Target.Column = 2 Then
    Lrow = Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To Lrow
        s = Cells(i, 2).Value
        If Cells(i, 2).Value <> "" Then
            Cells(i, 2).Offset(0, -1) = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(i - 1, 1))) + 1
        Else: Cells(i, 2).Offset(0, -1) = ""
        End If
    Next i
End If
Application.EnableEvents = True
End Sub

سلام
این کد هم که قرار دادید در واقع بر مبنای ستون دوم کار میکنه، و در صورتی که مقادیر در ستون های دیگری وارد شوند شماره ردیف قرار نمیده.
یک نمونه دیگر :

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("B2:B1000")) Is Nothing Then Exit Sub
 On Error Resume Next
 Dim nProg As Long, i As Long
 nProg = 1
    Range("A2:A1000").ClearContents
 
   For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
     If Cells(i, 2) <> "" Then
       Cells(i, 1) = nProg
       nProg = nProg + 1
     End If
   Next i


End Sub

[Amir Ghasemiyan]

سلام
این کد هم که قرار دادید در واقع بر مبنای ستون دوم کار میکنه، و در صورتی که مقادیر در ستون های دیگری وارد شوند شماره ردیف قرار نمیده.
یک نمونه دیگر :

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("B2:B1000")) Is Nothing Then Exit Sub
 On Error Resume Next
 Dim nProg As Long, i As Long
 nProg = 1
    Range("A2:A1000").ClearContents
 
   For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
     If Cells(i, 2) <> "" Then
       Cells(i, 1) = nProg
       nProg = nProg + 1
     End If
   Next i


End Sub

بله ولی کد قبلی شما فقط همون ردیف رو ویرایش میکرد. این کد که الان گذاشتین صحیح هست. کل ستون باید آپدیت بشن