شماره گذاری 2

[sohrabahmadi]

با سلام به اساتید ودوستان عزیز.در موضوع قبلی شماره گذاری فرمولی که جناب آقای امیر فرمودن در مورد داده های زیاد کند جواب میده .آیا راه حلی هست که در سریعترین زمان ممکن رو در کمترین زمان انجام بده ؟ ممنون میشم اگه راهنمایی بفرمایین
Sub counterrows()Dim ws As WorksheetDim i, lastline As IntegerSet ws = ActiveSheetlastline = Range("b65536").End(xlUp).Row For i = 1 To lastline If Cells(i, 2).Value <> "" Then ws.Cells(i, 1).Value = Application.Max(Range("A:A")) + 1 End If Next iEnd Sub

[amir_ts]

با سلام
قسمت lastline رو به این صورت بنویسید و تست کنید.

lastline = ws.Cells(ws.Rows.Count, "b").End(xlUp).Row 

Sub counterrows()
Dim ws As Worksheet
Dim i, lastline As Integer
Set ws = ActiveSheet
lastline = ws.Cells(ws.Rows.Count, "b").End(xlUp).Row
         For i = 1 To lastline
         If Cells(i, 2).Value <> "" Then
         ws.Cells(i, 1).Value = Application.Max(Range("A:A")) + 1
         End If
         Next i
End Sub

[sohrabahmadi]

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

[iranweld]

با سلام

ماکروی ذیل را تست کنید

Sub test()

Application.ScreenUpdating = False

ENDROW = Cells(Rows.Count, "B").End(xlUp).Row

X = 1

For I = 1 To ENDROW

If Range("B" & I) <> "" Then

Range("A" & I) = X

X = X + 1

End If

Next

Application.ScreenUpdating = True

End Sub