Đánh số tự động cho form nhập dữ liệu?

[HoangHacVT]

Chào anh em nhà GPE,

Mình có 1 form nhập dữ liệu (VD như file đính kèm). Mình muốn khi nhập dòng dữ liệu mới thì exel tự động đánh số thứ tự cho dòng đó.

Mò mẫm mấy ngày không ra, các anh em chỉ giáo giúp.

Cảm ơn nhiều.

Hỏi thêm: Mình xài excel 2007, nhưng hễ dữ liệu có chừng 1000 dòng trở lên là nó chạy như ông già 80 tuổi. Có cách nào để tăng tốc độ xử lý không?

 

[ThuNghi]

Bạn xem code sau thử.

Private Sub TextBox1_AfterUpdate()
Dim endR As Long, iStr As String, solan As Long, fR As Long
Dim myRng As Range
iStr = TextBox1.Value
With Sheet1
  endR = .Cells(65000, 1).End(xlUp).Row
  Set myRng = .Range(.Cells(2, 1), .Cells(endR, 2))
  With myRng
    .Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlGuess
  End With
  Set myRng = .Range(.Cells(3, 1), .Cells(endR, 1))
  solan = WorksheetFunction.CountIf(myRng, iStr)
  If solan > 0 Then
    fR = WorksheetFunction.Match(iStr, myRng, 0) + 2
    Set myRng = .Range(.Cells(fR, 2), .Cells(fR + solan - 1, 1))
  Else
    MsgBox "No"
    Me.TextBox2 = ""
  End If
  
End With
Me.TextBox2 = WorksheetFunction.Max(myRng)
Set myRng = Nothing
End Sub

 

[HoangHacVT]

Cám ơn ThuNghi, nhưng mà nó không chạy Nghi ơi!

Ở Textbox 1, nhập 1005 hay 1006 nó không làm gì hết, nhưng nhập 1007 thì nó ra cái Msgbox "No".

Nghi chỉ tiếp nhé!

 

[ThuNghi]

Cám ơn ThuNghi, nhưng mà nó không chạy Nghi ơi!

Ở Textbox 1, nhập 1005 hay 1006 nó không làm gì hết, nhưng nhập 1007 thì nó ra cái Msgbox "No".

Nghi chỉ tiếp nhé!

Chắc là properties của các textbox1 và 2 có chỗ nào kg cho vào.
Thay các textbox khác thử.

 

[ndu96081631]

Chắc là properties của các textbox1 và 2 có chỗ nào kg cho vào.
Thay các textbox khác thử.

Vì thuộc tính Enabled của TextBox2 đang set = False nên TextBox1 không dùng được sự kiện AfterUpdate (con trỏ phải đặt được vào TextBox2 thì code mới chạy)
Tuy nhiên ta vẫn có thể dùng kiểu khác mà ThuNghi

Private Sub TextBox1_Change()
  Dim SrcArray, i As Long, iMax As Long
  SrcArray = Sheet1.Range(Sheet1.[A3], Sheet1.[A65536].End(xlUp)).Resize(, 2).Value
  For i = 1 To UBound(SrcArray, 1)
    If SrcArray(i, 1) = TextBox1.Value Then
      If SrcArray(i, 2) > iMax Then iMax = SrcArray(i, 2)
    End If
  Next
  TextBox2 = iMax
End Sub

Cái vụ Array này vừa mới bàn xong cách đây mấy ngày thôi

 

[HoangHacVT]

Private Sub TextBox1_Change()
Dim SrcArray, i As Long, iMax As Long
SrcArray = Sheet1.Range(Sheet1.[A3], Sheet1.[A65536].End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(SrcArray, 1)
If SrcArray(i, 1) = TextBox1.Value Then
If SrcArray(i, 2) > iMax Then iMax = SrcArray(i, 2)
End If
Next
TextBox2 = iMax
End Sub

Cái vụ Array này vừa mới bàn xong cách đây mấy ngày thôi[/QUOTE]

Bác ndu cho mình hỏi thêm: mình muốn text2 chạy số dạng "006" chứ không phải "6", mò mẫm mãi vẫn không ra dủ đã thử nhiều cách. Bác chỉ tiếp cho mình với

Cám ơn,
Hạc

 

[sealand]

Mình tham gia thêm 1 cách là mượn tạm 1 vùng của sheet nào đó rồi dùng công thức Exc cũng được

Private Sub TextBox1_Change()
 Dim i
 i = Sheet1.[a65536].End(xlUp).Row
 Sheet1.[e2] = "'" & Me.TextBox1
 Sheet1.Range("e1").FormulaArray = "=MAX(IF(A2:A" & i & "=E2,B2:B" & i & ",0))"
 Me.TextBox2 = Format(Sheet1.[e1], "000")
 Sheet1.[e1:e2].ClearContents
End Sub

 

[HoangHacVT]

Mình tham gia thêm 1 cách là mượn tạm 1 vùng của sheet nào đó rồi dùng công thức Exc cũng được

Private Sub TextBox1_Change()
Dim i
i = Sheet1.[a65536].End(xlUp).Row
Sheet1.[e2] = "'" & Me.TextBox1
Sheet1.Range("e1").FormulaArray = "=MAX(IF(A2:A" & i & "=E2,B2:B" & i & ",0))"
Me.TextBox2 = Format(Sheet1.[e1], "000")
Sheet1.[e1:e2].ClearContents
End Sub

Cám on sealand nhiều.
Nhưng cái code "Me.TextBox2 = Format(Sheet1.[e1], "000")" nó nhất định không chạy ( trong cái sheet copy of HoiVBA.xls thì chạy, nhưng vô cái sheet của mình thì không. Mình phải mượn thêm một bước nữa như vầy:

Private Sub TextBox1_Change()
Dim i
i = Sheet1.[a65536].End(xlUp).Row
Sheet1.[e2] = "'" & Me.TextBox1
Sheet1.Range("e1").FormulaArray = "=MAX(IF(A2:A" & i & "=E2,B2:B" & i & ",0))"
Sheet1.Range(f1").select. activecell.value = "=IF(LEN(RC[-1])=1,""00""&RC[-1],IF(LEN(RC[-1])=2,""0""&RC[-1],RC[-1]))"
Me.TextBox2 = Sheet1.Range("f1").value
Sheet1.[e1:e2].ClearContents
End Sub

Sealand biết tại sao file của mình làm không được như vậy thì chỉ giáo cái nhe.

Cám ơn nhiều đa,

Hạc

 

[sealand]

Bạn chuyển sang 1 file ví dụ nhỏ thôi ròi gửi lên xem sao, doan code đó không thể không chạy?
Dùng hàm Text cũng OK

Private Sub TextBox1_Change()
Dim i
i = Sheet1.[a65536].End(xlUp).Row
Sheet1.[e2] = "'" & Me.TextBox1
Sheet1.Range("e1").FormulaArray = "=MAX(IF(A2:A" & i & "=E2,B2:B" & i & ",0))"
Me.TextBox2 = WorksheetFunction.Text(Sheet1.[e1], "000")
Sheet1.[e1:e2].ClearContents
End Sub