Em góp vui tí.
Sub GPE()
Dim lR As Long, I As Long
With Sheet10
lR = .Columns("A").Find(what:="T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng").Row
If lR < 9 Then
Exit Sub
ElseIf lR = 9 Then
.Rows(lR).Insert
.Range("A" & lR) = "DH00001"
Else
.Rows(lR).Insert
.Range("A" & lR) = "DH" & Format(Right(.Range("A" & (lR - 1)), 5) * 1 + 1, "00000")
End If
End With
End Sub
Đã dùng vba rồi thì thôi dùng Table được không?
Sub Button320_Click()
Dim opCal, LastRow As Long, sCode As String
opCal = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.CutCopyMode = False
With Sheet10 'With Sheets("TH theo DH")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
sCode = .Range("A" & LastRow - 1).Value
If LastRow < 9 Then Exit Sub
.Rows(LastRow).Insert Shift:=xlDown
If Len(sCode) > 0 Then .Range("A" & LastRow).Value = Left(sCode, 2) & Format(CLng(Mid(sCode, 3)) + 1, String(Len(sCode) - 2, "0"))
End With
Application.Calculation = opCal
Application.ScreenUpdating = True
End SubỞ đoạn code này; bạn bẫy luôn giúp mình cả 2 tình huống. Cảm ơn vanthinh3101 nhiều nhé
Ồ không dở chút nào đâu. Mình cảm ơn ♫ђöล♥ßล†♥†µ♫ nhiều; code của bạn ra kết quả vượt cả những gì mình mong đợi. Mình kiểm tra thử ở DH100000 thì code vẫn nỗi tiếp ra được DH100001 chứ không bị lỗi quay về DH00001Anh tham khảo thêm thôi nha. Cái em thêm vào dở ẹc
Cảm ơn anh befaint, tại em trót sử dụng Textbox sẵn có của Excel để lọc khách hàng rồi nên phải dùng Table name để chạy code.
Khi click vào nó vẫn hiển thị tốt đẹp mà --> kệ nó đi.
Private Sub TextBox1_Change()
Dim FindString As String
FindString = TextBox1.Text
With Sheet10 'With Sheets("TH theo DH")
If Len(FindString) = 0 Then
.ShowAllData
Else
.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="*" & FindString & "*"
End If
End With
End SubChuyển Table về Range:
Private Sub TextBox1_Change()
Dim FindString As String, lRow As Long, Rng As Range
FindString = TextBox1.Text
With Sheet10 'With Sheets("TH theo DH")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
If lRow < 8 Then Exit Sub
Set Rng = .Range("C8:C" & lRow)
If Len(FindString) = 0 Then
.AutoFilterMode = False
Else
Rng.AutoFilter Field:=1, Criteria1:="*" & FindString & "*"
End If
End With
End Sub
Cảm ơn HYen17 nha, trong ngày hôm nay Quang sẽ dành 1 khoảng thời gian đọc kỹ #9 này, chỗ nào chưa hiểu sẽ gửi thư hỏi thêm bạn sau.
Function MaVT(Dat As Date) As String
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
MaVT = Mid(Alf, Year(Dat) - 2000, 1)
MaVT = MaVT & Mid(Alf, 1 + Month(Dat), 1)
MaVT = MaVT & Mid(Alf, 1 + Day(Dat), 1)
End FunctionFunction IDToDate(StrC As String) As Date
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim Nm As Long, Th As Byte, Ng As Byte, VTr As Integer
VTr = InStr(Alf, Left(StrC, 1))
Nm = 2000 + VTr
VTr = InStr(Alf, Mid(StrC, 2, 1))
Th = VTr - 1
VTr = InStr(Alf, Right(StrC, 1))
Ng = VTr - 1
IDToDate = DateSerial(Nm, Th, Ng)
End Function
