Viết dùm em code tính tiền

  • Thread starter Thread starter Nguoiay
  • Ngày gửi Ngày gửi
Liên hệ QC

Nguoiay

Thành viên hoạt động
Tham gia
24/11/10
Bài viết
139
Được thích
34
Em có ví dụ này nhờ anh chị viết dùm em code tính thành tiền dùm em. Câu hỏi cụ thể trong file đính kèm!
 

File đính kèm

Em có ví dụ này nhờ anh chị viết dùm em code tính thành tiền dùm em. Câu hỏi cụ thể trong file đính kèm!
-Mình thấy excel rất tuyệt mà, tất nhiên + VBA nữa thì vô cùng. Nhưng sao phải dùng VBA bài bạn làm như vậy có sao đâu nhỉ? thầy vẫn ổn mà không thì dùng =IF(AND(C6>0,D6>0),C6*D6,""), cớ gì cứ phải dùng VBA cho nó lằng nhằng trong khi mình chưa thành thạo nhỉ. ;)
(hơ hơ, Bạn này lâu lâu lại up hình 1 em khác, nhiều người ấy quá nhé :)))))))))))))
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn keentwo! Nhưng mình muốn dùng code cơ. Mình muốn tìm hiểu code mà. Với lại cú thành thạo mới dùng đến code sao keentwo?
 
Upvote 0
Muốn có VBA thì VBA đây, xin mời xài tạm hàm tự tạo sau:

PHP:
Option Explicit
Function ThTien(DonGia As Double, Optional SLNhap As Integer, _
   Optional SLXuat As Integer, Optional NX As String = "X") As Double
 ThTien = DonGia * IIf(NX = "X", SLXuat, SLNhap)
End Function
Cách xài: Tại [e11] ta nhập cú fáp =ThTien(C6,D6, ,LEFT(D$4,1)) & copy xuống 4 dòng dưới xem răng!

Cũng rứa tại [G11]: =ThTien(C6, ,F6,LEFT(F$4,1))
 
Upvote 0
PHP:
Option Explicit
Function ThTien(DonGia As Double, Optional SLNhap As Integer, _
Optional SLXuat As Integer, Optional NX As String = "X") As Double
ThTien = DonGia * IIf(NX = "X", SLXuat, SLNhap)
End Function
Cách xài: Tại [e11] ta nhập cú fáp =ThTien(C6,D6, ,LEFT(D$4,1)) & copy xuống 4 dòng dưới xem răng!

Cũng rứa tại [G11]: =ThTien(C6, ,F6,LEFT(F$4,1))

Cám ơn bài viết của anh. Nhưng ý em là:
- Nếu phát sinh chứng từ nhập, khi ta nhập đơn giá vào cột C và Số lượng nhập và cột D (đk 2 cột này >0) thì cột E nó tự động tính.
- Nếu phát sinh chứng từ xuất, khi ta nhập đơn giá vào cột C và Số lượng nhập và cột F (đk 2 cột này >0) thì cột G nó tự động tính.
Trường hợp nếu không thoả mãn sẽ không tính hoặc tính sẽ bằng 0.
Em xem dùm em nhé!
 
Upvote 0
Cám ơn bài viết của anh. Nhưng ý em là:
- Nếu phát sinh chứng từ nhập, khi ta nhập đơn giá vào cột C và Số lượng nhập và cột D (đk 2 cột này >0) thì cột E nó tự động tính.
- Nếu phát sinh chứng từ xuất, khi ta nhập đơn giá vào cột C và Số lượng nhập và cột F (đk 2 cột này >0) thì cột G nó tự động tính.
Trường hợp nếu không thoả mãn sẽ không tính hoặc tính sẽ bằng 0.
Hàm Excel không chịu, hàm VBA cũng không chịu, thì dùng Sub. Đưa vào sự kiện Worksheet_Change, dùng Intersect để xác định cột cần thiết, dùng 1 cái If để chia trường hợp nhập xuất và 1 cái If để xác định điều kiện C và F (dùng Target.Offset).
Chả lẽ mới học xong khoá VBA đã quên hết rồi?

Đừng nói là quên luôn Intersect mới hỏi ở đây và Worksheet_Change mới hỏi ở đây nha.
 
Lần chỉnh sửa cuối:
Upvote 0
Em làm thế này nhưng không được. Các AC chỉ dùm nha:
Sheet1:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    i = Range("A65535").End(xlUp).Row
    If Not Intersect(Range("D6:D65535,F6:F65535"), Target) Is Nothing Then
        If Cells(i, 4) > 0 Then
            Cells(i, 5).Formula = "=RC[-2]*RC[-1]"
        ElseIf Cells(i, 6) > 0 Then
            Cells(i, 7).Formula = "=RC[-4]*RC[-1]"
        End If
    End If
End Sub
Các AC giơ tay đánh khẽ em nhé!!
 
Upvote 0
Em làm thế này nhưng không được. Các AC chỉ dùm nha:
Sheet1:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    i = Range("A65535").End(xlUp).Row
    If Not Intersect(Range("D6:D65535,F6:F65535"), Target) Is Nothing Then
        If Cells(i, 4) > 0 Then
            Cells(i, 5).Formula = "=RC[-2]*RC[-1]"
        ElseIf Cells(i, 6) > 0 Then
            Cells(i, 7).Formula = "=RC[-4]*RC[-1]"
        End If
    End If
End Sub
Các AC giơ tay đánh khẽ em nhé!!
Thử sửa lại như vầy xem?
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("D6:D65535"), Target) Is Nothing Then
        Target.Offset(, 1).FormulaR1C1 = "=RC[-1]*RC[-2]"
        Target.Offset(, 1) = Target.Offset(, 1)
    End If
    If Not Intersect(Range("F6:F65535"), Target) Is Nothing Then
        Target.Offset(, 1).FormulaR1C1 = "=RC[-1]*RC[-4]"
        Target.Offset(, 1) = Target.Offset(, 1)
    End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Thử sửa lại như vầy xem?
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("D6:D65535"), Target) Is Nothing Then
        Target.Offset(, 1).FormulaR1C1 = "=RC[-1]*RC[-2]"
        Target.Offset(, 1) = Target.Offset(, 1)
    End If
    If Not Intersect(Range("F6:F65535"), Target) Is Nothing Then
        Target.Offset(, 1).FormulaR1C1 = "=RC[-1]*RC[-4]"
        Target.Offset(, 1) = Target.Offset(, 1)
    End If
End Sub
Lở người ta không gõ bằng tay mà copy (ở đâu đó) paste vào nhiều cell cùng 1 lúc thì sao ta?
Ngoài ra, khi dùng Worksheet_Change sẽ không lường trước những lỗi có thể xãy ra đâu ---> Ví dụ ta xóa bớt hoặc chèn thêm 1 dòng
 
Upvote 0
Lở người ta không gõ bằng tay mà copy (ở đâu đó) paste vào nhiều cell cùng 1 lúc thì sao ta?
Ngoài ra, khi dùng Worksheet_Change sẽ không lường trước những lỗi có thể xãy ra đâu ---> Ví dụ ta xóa bớt hoặc chèn thêm 1 dòng

Vâng, hiện tại em cũng đang gặp phải trường hợp chèn dòng này. Thầy vui lòng tư vấn dùm em thêm trong trường hợp này dùng cách nào tốt nhất?
Em cám ơn thầy ndu nhiều!
 
Upvote 0
Vâng, hiện tại em cũng đang gặp phải trường hợp chèn dòng này. Thầy vui lòng tư vấn dùm em thêm trong trường hợp này dùng cách nào tốt nhất?
Em cám ơn thầy ndu nhiều!
Tốt nhất là không dám chắc (ai lường trước nỗi chuyện không may)
Tạm thời thử code này xem:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range
  On Error GoTo ExitSub
  If Not Intersect(Union([D6:D10000], [F6:F10000]), Target) Is Nothing Then
    If Target.Columns.Count = 1 Then
      For Each Clls In Target
        If Cells(Clls.Row, "C") > 0 Then
          Clls.Offset(, 1) = Clls * Cells(Clls.Row, "C")
        End If
      Next
    End If
  End If
ExitSub:
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom