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

Collapse
X
Collapse
 
  • صفحه از 1
  • زمان
  • نمایش
حذف همه
new posts
قبلی template بعدی
  • سهیل نصرت آبادی1

    • 2011/01/22
    • 64
    #1

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

    سلام

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

      • 2018/04/23
      • 677
      #2
      نوشته اصلی توسط سهیل نصرت آبادی1
      سلام

      اگر به عنوان مثال 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]
      فایل اکسل
      [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
      [/CENTER]

        کامنت

        • Amir Ghasemiyan

          • 2013/09/20
          • 4598
          • 100.00
          #3
          نوشته اصلی توسط M_ExceL
          سلام
          کد:
          [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

              • 2018/04/23
              • 677
              #4
              نوشته اصلی توسط Amir Ghasemiyan
              به نظر مياد كدتون ناقص باشه دوست عزيز
              نياز به يك حلقه هست كه همه ستون رو بررسي كنه
              سلام جناب قاسمیان
              بله این کد در واقع ستون دوم رو در نظر میگیره، روش کار میکنم ببینم چی میشه
              شما هم اگر امکانش بود کد رو اصلاح بفرمایید ...
              با تشکر
              [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
              [/CENTER]

                کامنت

                • Amir Ghasemiyan

                  • 2013/09/20
                  • 4598
                  • 100.00
                  #5
                  این کدی هست که من پیشنهاد میکنم دوست عزیز

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

                  کد:
                  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

                      • 2018/04/23
                      • 677
                      #6
                      نوشته اصلی توسط 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
                      سلام
                      این کد هم که قرار دادید در واقع بر مبنای ستون دوم کار میکنه، و در صورتی که مقادیر در ستون های دیگری وارد شوند شماره ردیف قرار نمیده.
                      یک نمونه دیگر :
                      کد:
                      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
                      [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
                      [/CENTER]

                        کامنت

                        • Amir Ghasemiyan

                          • 2013/09/20
                          • 4598
                          • 100.00
                          #7
                          نوشته اصلی توسط M_ExceL
                          سلام
                          این کد هم که قرار دادید در واقع بر مبنای ستون دوم کار میکنه، و در صورتی که مقادیر در ستون های دیگری وارد شوند شماره ردیف قرار نمیده.
                          یک نمونه دیگر :
                          کد:
                          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
                          بله ولی کد قبلی شما فقط همون ردیف رو ویرایش میکرد. این کد که الان گذاشتین صحیح هست. کل ستون باید آپدیت بشن

                            کامنت

                            قبلی template بعدی
                            چند لحظه..