Hướng Dẫn Cách Làm Công Thức Tự Động Tăng Số Phiếu Nhập, Xuất

Liên hệ QC

ManhHungMHNH

Thành viên chính thức
Tham gia
21/1/07
Bài viết
76
Được thích
0
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/+-+-+-+
 

File đính kèm

File đính kèm

Xài thử macro này xem sao?

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
PHP:
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

Hướng dẫn sử dụng: Nhập các tài khoản 152, 153, 155 & 156 vô cột 'F' hay 'G', ta sẽ được nhập tự động số phiếu tại cột 'B'

(*) Vẫn chưa rõ ở chỗ: Khi số phiếu nào đó sau -999 thì sẽ là bao nhiêu đây?
 

File đính kèm

Lần chỉnh sửa cuối:
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/+-+-+-+
Ô B10 nhập công thức:
Mã:
=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"))
---
To SA_DQ: Tôi xoá dữ liệu rồi nhập lại thì code không chạy, không hiểu vì sao:
 
Lần chỉnh sửa cuối:
Ờ hén! Rất cảm ơn bạn đã phát hiện ra vấn đề như vậy

Tôi xoá dữ liệu rồi nhập lại thì code không chạy, không hiểu vì sao:
Bạn dùng đoạn mã này để thay toàn bộ macro trên:
PHP:
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
 
Lần chỉnh sửa cuối:
Mình đã làm nhưng có một chút mình chưa biết là nếu cùng trên 1 số hoá đơn, giống nhau về ngày tháng, số hoá đơn nhưng lại tự động ra 2 số phiếu. Mình muốn nếu trên 1 số hoá đơn, giống nhau về ngày tháng, số hoá đơn thì hiện một số phiếu thôi. nhờ bạn và mọi người hướng dẫn hộ mình nhé.
Mình cảm ơn.&&&%$R
 

File đính kèm

Bạn thử nghiệm với cái ni & chúc khỏe!

PHP:
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
 
Web KT

Bài viết mới nhất

Back
Top Bottom