Tạo cột STT

[ZzNHCzZ]

Xin chào các anh chị GPE
Em đang tập viết Macro nên có bài muốn hỏi anh chị.
Em muốn tạo cột STT tự động cập nhật:

Với công thức thì em làm như sau: A2 =IF(B2="","",MAX($A$1:A1)+1)
Thì nếu như cột B2 có dữ liệu thì A2 sẽ = 1 tương tự như thế cho các dòng dưới.

Với Macro thì em không biết làm như thế nào, và dùng vòng lặp
Em viết như thế này ko biết sai chổ nào, mong anh chị giúp đở

Sub STT()
Dim i as long
For i = 2
i+1
If Sheet1.Range("B" & i).Value = "" Then
Sheet1.Range("A" & i).Value = "" Then
Esle
Sheet1.Range("A" & i).Value = "IF(B2="","",MAX($A$1:A1)+1)" Then
Next i
End sub

Chân thành cám ơn anh chị

 

[anhphuong]

Bạn thiếu một dấu "=" nữa. Hãy thử dùng Record Macro là biết liền hà
Chú ý công thức ghi trong VBA khác với cách ghi trong Sheet

Sub STT()
Dim i As Long
Sheets("Sheet1").Select
n = Application.WorksheetFunction.CountA(Range("B2:B65000"))
For i = 2 To n
[COLOR=black]If Range("B" & i).Value = "" Then[/COLOR]
[COLOR=black]Range("A" & i).Value = ""[/COLOR]
[COLOR=black]Esle[/COLOR]
[COLOR=black]Range("A" & i).Value = "=MAX($A$1:A & i)+1" [/COLOR]
[COLOR=black]End If[/COLOR]
[COLOR=black]Next[/COLOR]
[COLOR=black]End Sub[php/][/COLOR]
 
Thân

 

[ZzNHCzZ]

Sub STT()
Dim i As Long
Sheets("Sheet1").Select
n = Application.WorksheetFunction.CountA(Range("B2:B65 000"))
For i = 2 To n
If Range("B" & i).Value = "" Then
Range("A" & i).Value = ""
Esle
Range("A" & i).Value = "=MAX($A$1:A & i)+1"
End If
Next
End Sub

Em đã copy code của anhphuong nhưng không chạy.
anh xem lại giúp em hoặc gửi file nhé

Thân!

 

[ndu96081631]

Bạn thử code này xem:

Option Explicit
Sub STT()
Dim i, Er, MaxSTT As Integer
Er = Range("B1000").End(xlUp).Row
MaxSTT = 0
Range("A2:A" & Er).Clear
For i = 2 To Er
  MaxSTT = Application.WorksheetFunction.Max(Range("$A$2:A" & i))
  If Range("B" & i).Value = "" Then
     Range("A" & i).Value = ""
  Else
     Range("A" & i).Value = MaxSTT + 1
  End If
Next
End Sub

 

[anhphuong]

Xin lỗi vì hơi vội nên viết sai .Ban sửa lại đoạn code trên như sau

Sub STT()
Sheets("Sheet1").Select
n = Application.WorksheetFunction.CountA(Range("B2:B65000"))
If n > 0 Then
    Range("A2").Select
    ActiveCell.Value = "=MAX($A$1:A1)+1"
    Selection.Copy
    Range("A3:A" & n + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End If
End Sub

 

[Trần Văn Bình]

Tiện thể cho em hỏi luôn khi tạo này thì phải nhấn Alt+F8 mới chạy còn khi cột B:B khi nhập số liệu hàng nào thì tại cột A:A tự động điền vào theo thứ tự thì làm thế nào

 

[ndu96081631]

Tiện thể cho em hỏi luôn khi tạo này thì phải nhấn Alt+F8 mới chạy còn khi cột B:B khi nhập số liệu hàng nào thì tại cột A:A tự động điền vào theo thứ tự thì làm thế nào

Sửa lại code thành sự kiện WorkSheet_Change

 

[ThuNghi]

Góp vui, mượn tạm code để chỉnh

Option Explicit
Sub STT()
Dim iAs Integer, j As Integer,Er As Integer
Er = Range("B1000").End(xlUp).Row
Range("A2:A" & Er).Clear
j=1
For i = 2 To Er
If Range("B" & i).Value <> "" Then
Range("A" & i).Value = j
j=j+1
End If
Next
End Sub

 

[voda]

Code của bác anhphuong có ưu điểm là : khi thay đổi dữ liệu cột B, cột A sẽ tự động cập nhật STT ( không cần chạy lại code). Mình thấy cần tăng giá trị của biến n để code chạy hết vùng dữ liệu. Có thể chỉnh lại một chút như sau:

Sub STT()
Sheets("Sheet1").Select
n = Range("B65000").End(xlUp).Row
If n > 0 Then
    Range("A2").Select
    ActiveCell.Value = "=IF(B2="""","""",MAX($A$1:A1)+1)"
    Selection.Copy
    Range("A3:A" & n + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End If
End Sub

 

[Mr Okebab]

Em góp vui với :
Nếu dữ liệu là liên tục và bắt đầu từ dòng thứ 2 :

Sub STT()
    On Error Resume Next
    With Range("A2:A" & Range("B65000").End(xlUp).Row)
        .FormulaR1C1 = "=ROW()-1"
        .Calculate
        .Value = .Value
    End With
End Sub

Thân!

 

[Trần Văn Bình]

Code của bác anhphuong có ưu điểm là : khi thay đổi dữ liệu cột B, cột A sẽ tự động cập nhật STT ( không cần chạy lại code). Mình thấy cần tăng giá trị của biến n để code chạy hết vùng dữ liệu. Có thể chỉnh lại một chút như sau:

Sub STT()
Sheets("Sheet1").Select
n = Range("B65000").End(xlUp).Row
If n > 0 Then
    Range("A2").Select
    ActiveCell.Value = "=IF(B2="""","""",MAX($A$1:A1)+1)"
    Selection.Copy
    Range("A3:A" & n + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End If
End Sub

Mình chạy thử nhưng chỉ được 2 hàng

 

[ndu96081631]

Mình chạy thử nhưng chỉ được 2 hàng

Bạn thử code này! Tự động theo nhập liệu luôn

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, Er, K As Integer
Dim Rng, Clls As Range
Er = Range("B1000").End(xlUp).Row + 1
Set Rng = Range("B2:B" & Er)
K = 0
  If Not Intersect(Range("B2:B1000"), Target) Is Nothing Then
    Range("A2:A1000").Clear
    For Each Clls In Rng
      If Clls <> "" Then
         Clls.Offset(, -1).Value = K + 1
         K = K + 1
      End If
    Next
  End If
End Sub

 

[voda]

Trích:

Nguyên văn bởi Trần Văn Bình
Mình chạy thử nhưng chỉ được 2 hàng

Mình test rồi mới up lên. Code này không thể chạy 2 hàng, trừ khi bên cột B chỉ 2 hàng có dữ liệu. Bạn xem file thử nhé!

 

[ndu96081631]

Trích:

Mình test rồi mới up lên. Code này không thể chạy 2 hàng, trừ khi bên cột B chỉ 2 hàng có dữ liệu. Bạn xem file thử nhé!

Thầy cho em hỏi: Về phần code thì không bàn đến, nhưng nếu chỉ là điền công thức vào cell vậy ta cần gì dùng code? Tại sao không điền thẳng công thức vào cell bằng tay?

 

[voda]

-Điều này là chỉ làm theo hướng mà bạn ZzNHCzZ nêu ra trong bài #1 chứ không phải nêu lên cách làm tốt nhất. Thường ta nhập công thức bằng tay nhưng cũng có lúc nào đó phải thực hiện bằng code. Có nghĩa là tùy nghi sử dụng theo tình huống cụ thể.
-Theo mình, cách của ThuNghi ( bài #8) là gọn nhẹ nhất.