ManhHungMHNH
Thành viên chính thức
![](/diendan/data/PhoToDanhHieu/gold.gif)
![](/diendan/data/PhoToDanhHieu/gold.gif)
- Tham gia
- 21/1/07
- Bài viết
- 76
- Được thích
- 0
Bạn xem có đúng không nhá!Nhờ mọi người nghiên cứu và làm giúp hộ mình với công thức của File trên với rất cần à.
Rất mong a.
Em xin chân thành cảm ơn.
Mình Nhờ Mọi Người Làm giùm mình công thức tự động tăng số chứng từ nhập, xuất kho của các tài khoản 152; 153; 155; 156. (Kèm theo File)
Xin Chân Thành Cảm ơn Nhiều
Option Explicit
Const MyRec As Long = 999
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F9:G" & MyRec)) Is Nothing Then
Const GN As String = "-"
Dim Rng As Range, sRng As Range, StrC As String
Set Rng = Range([B9], Cells(MyRec, "B"))
If Target.Column = 6 And (Target.Value = 155 Or Target.Value = 156 Or _
Target.Value = 152 Or Target.Value = 153) Then
StrC = "N"
ElseIf Target.Column = 7 And (Target.Value = 152 Or Target.Value = 153 Or _
Target.Value = 155 Or Target.Value = 156) Then
StrC = "X"
End If
StrC = StrC & Target.Value
Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)
If Not sRng Is Nothing Then
Set sRng = Rng.FindPrevious(sRng)
StrC = StrC & GN & Right("00" & CStr(CInt(Right(sRng.Value, 3)) + 1), 3)
Cells(Target.Row, "B").Value = StrC
End If
End If
End Sub
Ô B10 nhập công thức:Mình Nhờ Mọi Người Làm giùm mình công thức tự động tăng số chứng từ nhập, xuất kho của các tài khoản 152; 153; 155; 156. (Kèm theo File)
Xin Chân Thành Cảm ơn Nhiều/![]()
=IF(OR(F10=152;F10=153;F10=155;F10=156);"N"&F10&"-"&TEXT(COUNTIF($F$10:F10;F10);"000");"X"&G10&"-"&TEXT(COUNTIF($G$10:G10;G10);"000"))
Bạn dùng đoạn mã này để thay toàn bộ macro trên:Tôi xoá dữ liệu rồi nhập lại thì code không chạy, không hiểu vì sao:
Option Explicit
Const MyRec As Long = 999
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F9:G" & MyRec)) Is Nothing Then
Const GN As String = "-": Dim tValue As Variant '*'
Dim Rng As Range, sRng As Range, StrC As String
Set Rng = Range([B9], Cells(MyRec, "B"))
tValue = Target.Value
If Target.Column = 6 And (tValue = 155 Or tValue = 156 Or _
tValue = 152 Or tValue = 153) Then
StrC = "N"
ElseIf Target.Column = 7 And (tValue = 152 Or tValue = 153 Or _
tValue = 155 Or tValue = 156) Then
StrC = "X"
End If
StrC = StrC & tValue
Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)
If sRng Is Nothing Then '*'
If tValue = 152 Or tValue = 153 Or tValue = 155 Or tValue = 156 Then
Cells(Target.Row, "B").Value = StrC & GN & "001" '*'
End If '*'
Else '*'
Set sRng = Rng.FindPrevious(sRng)
StrC = StrC & GN & Right("00" & CStr(CInt(Right(sRng.Value, 3)) + 1), 3)
Cells(Target.Row, "B").Value = StrC
End If
End If
End Sub
Option Explicit
Const MyRec As Long = 999
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F9].Resize(MyRec, 2)) Is Nothing And Target.Count = 1 Then
Const GN As String = "-": Dim tValue, Hang As Long
Dim Rng As Range, sRng As Range, StrC As String
Set Rng = Range([B9], Cells(MyRec, "B"))
tValue = Target.Value: Hang = Target.Row
If Target.Column = 6 And (tValue = 155 Or tValue = 156 Or _
tValue = 152 Or tValue = 153) Then
StrC = "N"
ElseIf Target.Column = 7 And (tValue = 152 Or tValue = 153 Or _
tValue = 155 Or tValue = 156) Then
StrC = "X"
End If
StrC = StrC & tValue
Set sRng = Rng.Find(StrC, , xlFormulas, xlPart)
If sRng Is Nothing Then
If tValue = 152 Or tValue = 153 Or tValue = 155 Or tValue = 156 Then _
Cells(Hang, "B").Value = StrC & GN & "001"
Else
Set sRng = Rng.FindPrevious(sRng)
If sRng.Offset(, 2).Value = Cells(Hang, "D").Value And _
sRng.Offset(, 3).Value = Cells(Hang, "E").Value Then
Cells(Hang, "B").Value = Cells(sRng.Row, "B").Value
Else
StrC = StrC & GN & Right("00" & CStr(CInt(Right(sRng.Value, 3)) + 1), 3)
Cells(Hang, "B").Value = StrC
End If
End If
End If
End Sub