(1) Thực ra code ở #3 không đúng thực tế; Vì trong 1 loạt các mặt hàng nhập khác nhau của 1 hóa đơn, không fải chúng cùng 1 cách chiết khấu.
Private Sub CommandButton2_Click() 'Tao Moi'
Dim VTr As Byte, SoHD As String, Num As Integer
Union([B10:B58], [D10:F58]).Value = ""
VTr = InStr([g5].Value, "/")
SoHD = Mid([g5].Value, 3, VTr - 3)
Num = CInt(SoHD)
[g5].Value = "PX" & Right("000" & CStr(Num + 1), 4) & "/" & CStr(Year(Date) Mod 100)
End SubPrivate Sub CommandButton2_Click() 'Tao Moi'
Dim SoHD As String, Num As Integer
Dim Sh As Worksheet, Rng As Range, Cls As Range
Union([B10:B58], [D10:F58]).Value = ""
Set Sh = Sheets("CSDL")
Set Rng = Sh.Range(Sh.[c2], Sh.[c65500].End(xlUp))
For Each Cls In Rng
If Cls.Value > SoHD Then SoHD = Cls.Value
Next Cls
If Right(SoHD, 2) < CStr(Year(Date) Mod 100) Then
[G5].Value = "PX0001/" & CStr(Year(Date) Mod 100)
Else
SoHD = Mid(SoHD, 3, 4): Num = CInt(SoHD) + 1
[G5].Value = "PX" & Right("000" & CStr(Num), 4) & "/" & CStr(Year(Date) Mod 100)
End If
End SubPrivate Sub CommandButton2_Click() 'Tao Moi'
Dim SoHD As String, Num As Integer, XinHoi As Byte '<=|'
Dim Sh As Worksheet, Rng As Range, Cls As Range
Set Sh = Sheets("CSDL")
Set Rng = Sh.Range(Sh.[c2], Sh.[c65500].End(xlUp))
1 If Rng.Find([G5].Value, , xlFormulas, xlWhole) Is Nothing Then
XinHoi = MsgBox("Ban Khong Càn Luu Du Lieu?", 33, "Ban Chua Luu Vào CSDL")
If XinHoi > 1 Then Exit Sub
2 End If
Union([B10:B58], [D10:F58]).Value = "": [G5].Interior.ColorIndex = 35
For Each Cls In Rng
If Cls.Value > SoHD Then SoHD = Cls.Value
Next Cls
If Right(SoHD, 2) < CStr(Year(Date) Mod 100) Then
[G5].Value = "PX0001/" & CStr(Year(Date) Mod 100)
Else
SoHD = Mid(SoHD, 3, 4): Num = CInt(SoHD) + 1
[G5].Value = "PX" & Right("000" & CStr(Num), 4) & "/" & CStr(Year(Date) Mod 100)
End If
End SubPrivate Sub CommandButton3_Click() ' Luu'
Dim Sh As Worksheet, Cls As Range, Rng As Range
Dim Rws As Long, DaGhi As Boolean '<=|'
Set Sh = Sheets("CSDL"): Rws = Sh.[B65500].End(xlUp).Offset(1).Row
Set Cls = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
If Not Cls.Find([G5].Value, , xlFormulas, xlWhole) Is Nothing Then
MsgBox "Da Nhap Ròi, Ban Oi", , "GPE Xin Luu Ý": Exit Sub
End If
For Each Cls In Range("B10:B58")
If Cls.Value <> "" Then
If DaGhi = False Then '<=|'
7 With Sh.Cells(Rws, "B")
.Value = [C7].Value: DaGhi = True
.Offset(, 3).Value = "G Chu"
.Offset(, 1).Value = [G5].Value
.Offset(, 2).Value = [G7].Value
End With
End If '<=|'
8 With Sh.[G65500].End(xlUp).Offset(1)
.Value = [G5].Value 'Só Hoá Don'
.Offset(, 1).Resize(, 5).Value = Cls.Resize(, 5).Value
End With
End If
Next Cls
With [G7].Interior
If .ColorIndex = 35 Then .ColorIndex = 38 Else .ColorIndex = 35
End With
End SubĐể cải tiến tiếp, chúng ta cần biêt số mã hàng của cơ sở bạn đang kinh doanh.
, nếu may mắn gặp người tốt thì người ta tính lại còn gặp người xấu thì họ đi luôn.Do đó hôm nay em muốn excel tự điền CK và cho dù em xuất sai MaHH thì cũng không sai CK.
1/ Tôi cũng đồng ý với ý Bác Sa (ChanhTQ) về vấn đề này, nên thêm 1 cột dùng validation để lấy giá bán.
)Khi khách hàng lại mua hàng họ sẽ ghi SL của tùng loại hàng ra và em sẽ đánh vào trang tính HD và HD lúc này sẽ có là : MaHH - SL - Giá gốc(giá chưa trừ %CK) - thành tiền ,rồi lúc này em sẽ nhìn vào HD để xem nó có tổng số tiền là bao nhiêu và nó thuộc loại nào trong 4 loại giá trên nếu nó nằm trong khoảng nào thì em lấy giá khoảng đó (xem hình minh hoạ).Chứ không phải mỗi loại MãHH mang 1 giá như HYEN nghỉ đâuLàm điều này có mạng lại điều gì trong vấn đề viết code không HYEN vd :file truy xuất nhanh hơn hay dể viết code hơn <----- phần này thuộc kỹ thuật em không rành HYEN thấy làm sao thuân tiện cho viêc viết code của HYEN thì cứ sữa em k biết về nó
Hi HYEN cũng là 1 nhà kinh doanh có tâm tư suy nghỉ lâu dài nhỉ,đây cũng là 1 cách giúp kinh doanh hiệu quả em xin tiếp thua ý kiến này,cảm ơn HYEN
,em sẽ học hỏi thêm.
Như vậy mình hiểu là tùy vào tổng lượng tiền của hóa đơn & người mua mà có chiết khấu chung cho 1 hóa đơn?VD :Gia1-->thuộc HD< 1 triệu,Gia2--->thuộc 1trieu< HD < 2 triệu,Gia3-->thuộc 2trieu < HD < 3trieu ,Giá tự do ---> do em tự đánh CK vào (giá này tuỳ theo khách hàng là bà con hay người ngoài mà tính giá hihi
Phần làm phiếu bán hàng này nếu theo nghĩa đơn giản thì cũng không phức tạp lắm. Có chăng là sự diễn đạt yêu cầu chưa rõ hay chưa cụ thể lắm. Những yêu cầu của bạn ở sh HDon mình sẽ diễn "nôm" như sau nhé. Khoan bàn về kỹ thụât hay code.
Khi lập phiếu bán hàng (PBH) mới, số PBH sẽ update và sh Hdon sẽ hiện 50 MaHH, tên hàng và giá bán với CK=0. Khi đánh số lượng tương ứng vào thì TenHH, GiaBan và ThanhTien sẽ màu đen với CK=0. Dùng conditional Format.
Khi nhập CK thì GiaBan và thành tiền sẽ thay đổi theo CK.
Vấn đề này cũng dễ.
Lúc này chúng ta sẽ chọn CK và GiaBan và thành tiền sẽ thay đổi theo CK đã chọn,VD : Nếu chọn CK 1,2,3,4 thì sẽ lấy CK từ sh HHoa,còn nếu chọn CK 0 thì CK ở PBH=0 và ta sẽ tự đánh vào,khi đánh CK vào thì GiaBan và thành tiền sẽ thay đổi theo CK mới đánh vào
Em với Bác Sa cùng nhau hoàn thiện cho bạn ấy nha, không dám ganh đua với Bác. Hy vọng làm xong anh em mình sẽ được 1 chầu bầu đá + ...
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
2 If Not Intersect(Target, [f1]) Is Nothing Then
UpdateCK
End If
Application.ScreenUpdating = True
End SubOption Explicit 'Khai Báo Các Biến Dùng Chung Trong Modyle:'
Dim SoHD As String, Num As Integer
Dim Sh As Worksheet, Rng As Range, Cls As Range
Dim endR As Long, i As Long
Dim wf As WorksheetFunction
Sub UpdateCK()
Set wf = WorksheetFunction ' Gán Đối Tượng Cho 1 Biến Đối Tượng'
With Sheets("HHoa") ' Với Trang "HHoa"'
endR = .Cells(65000, 3).End(xlUp).Row 'Lấy Dòng Cuối Cột "C" có Dữ Liệu Gán Vô Biến Đã Khai Báo'
Set Rng = .Range("C4:M" & endR) 'Lấy Vùng Từ C4 Cho tới Dòng Cuối Của Cột M Gán Vô Biến Rng'i
End With
With Sheets("HDon") 'Với Trang tính "HDon"'
Num = .[f1] ' Lấy Trị tại [F1] gán vô biến Num'
For i = 59 To 10 Step -1 'Tạo Vòng Lặp từ dòng 59 cho tới 10 - Vùng ta nhập liệu'
If Len(.Cells(i, 4)) = 0 Then 'Nếu Chiếu Dài Dữ Liệu của Ô thuộc dòng đang khảo sát ở cột 4 = 0'
.Rows(i).EntireRow.Hidden = True ' Thì Đem Ẩn Dòng Đó Đi'
Else ' Bằng không thì:'
If Num = 0 Then ' Nếu Num = 0 Thì:'
.Cells(i, 5) = 0 'Ô thuộc cột 5 của Dòng Đang khảo sát gán trị Bằng [SIZE="3"]0[/SIZE] '
Else ' Nếu Ngược Lại:'
' Ô thuộc Cột 5 Của Dòng KS sẽ nhận trị từ hàm LOOKUP()'
.Cells(i, 5) = wf.VLookup(.Cells(i, 3), Rng, Num * 2 + 2, 0)
End If 'Kết thúc Đ/k Trong'
End If 'Kết thúc Đ/k Ngoài'
Next i 'Kết thúc Vòng Lặp'
End With
'Xã biến để fục hồi bộ nhớ:'
Set Rng = Nothing: Set wf = Nothing
End SubHi em là người kinh doanh nên mù tịch về tin học,nhưng vì công việc đòi hỏi sự nhanh và chính xác nên ráng mài mò học hỏi,được các anh chị giúp đỡ nhiệt tình như thế này là mình vô cùng biết ơn rồi không dám trách móc gì đâu (có dịp xin được hậu tạ)
OK, đưa makh vào G6 để mình ktra, nếu kg muốn có thể cho màu trắng là kg in ra.
Tôi chưa sửa gì về CK cả, và hiện tại tôi cũng chọn thử như bạn và chọn lại CK thì cũng không thấy chậm. Bạn có thể gởi cái hình mà bạn chọn Print Preview.
Khỏi cần, quy trình là gì
Sub UpdateCK()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wf = WorksheetFunction
With Sheets("DMHH")
endR = .Cells(65000, 3).End(xlUp).Row
Set Rng = .Range("C4:M" & endR)
End With
With Sheets("HDon")
Num = .[f1]
For i = 59 To 10 Step -1
If Len(.Cells(i, 4)) = 0 Then
.Rows(i).EntireRow.Hidden = True
Else
If Num = 0 Then
.Cells(i, 5) = 0
Else
.Cells(i, 5) = wf.VLookup(.Cells(i, 3), Rng, Num * 2 + 2, 0)
End If
End If
Next i
End With
Set Rng = Nothing: Set wf = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End WithSiêu đâu mà siêu mới lên google search ra đó ThụNghi ơi hihi
Đang xem lại, về nhà sẽ xem và trả lời ngay. Nếu CK -> in -> Lưu, sao lại phải chọn CK lại. Chọn CK có thể là dùng bước sửa.
Sub unHide01()
With Sheets("VD")
.Rows("10:59").EntireRow.Hidden = False
End With
End Sub
Sub Hide01()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Sheets("VD").Select
unHide
With Sheets("VD")
For i = 59 To 10 Step -1
If .Cells(i, 4) = 0 Then
.Rows(i).EntireRow.Hidden = True
End If
Next i
End With
'Set Rng = Nothing: Set wf = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End SubSorry, phần này do lồng if sai. Đã sửa lại.
Đã làm lại nhưng vẫn giữ validation. Không cần thì bỏ đi.
Có gán thêm 1 phần lưu khi tạo HĐ mới, bạn xem nếu kg OK thì sửa chữa lại 1 chút.
Cái này nên tường minh, làm thêm 1 code bẫy cũng OK nhưng thấy no need. Và lưu ý phần cột CK ở DMHH thì không được merge cell. Và chỉ cần quan tâm CK, không cần tính ra giá làm gì. Có thể bỏ cột tính ra giá ở DMHH nhưng phải giữ TT cột. Nếu bỏ thì báo để sửa code.
Phần này làm thêm thôi, chớ khi chọn maKH thì nó cũng lấy DMKH rồi, có thể bỏ.
Cái này hoàn toàn số học. Tự nghiên cứu.
Nếu như DMHH mình không thể merge cell được thì mình thông qua 1 sheet khác có merge cell để lấy dữ liệu cho cột CK được không.Cụ thể em tạo thêm 1 sheet BGIA (đã merge cell) và em muốn cột CK% của sh DMHH lấy dữ liệu CK% từ sh BGIA có được không?Giá 2 và Giá 3 của sh DMHH bằng Giá 2 và Giá 3 của sh BGIA
Hi em có nghiên cứu và làm được nhưng em thấy công thức sao nó đơn giản và kì kì quá nên mới hỏi thôi (em đã tạo công thức bằng cách -0.01) ThuNghi xem giúp coi có đúng không.
Đã gọi là cơ sở dữ liệu (CSDL) thì không nên merge cell, viết code không khó nhưng không hệ thống, tôi thấy trong sh BGIA mà ct tính đơn giá không nhất quán thì không nên. Tôi đề xúât như sau:
Vậy bạn làm lại 1 file chỉ gồm sh BGia và Sh DMHH up lên, số liệu về CK gần giống thực tế . Nhớ là không thay đổi cấu trúc sh DMHH.
Đúng vậy thực sự mình chỉ cần quan tâm đến CK thồi còn cột Giá bán đã CK thì không cần thiết,sỡ dĩ mình thêm vào là để đôi lúc mình nhìn và so sánh cho dễ hiểu và đỡ sai sót thôi
Nhớ kiểm tra nhiều tình huống, ì OK thì gắn vào file nhé. Làm với file merge mình thấy không an tâm.
Nếu mà để trống làm ơn đừng merge cell, vì code nó chỉ lấy dk là nếu merge và =0 thì lấy CK của trên nó.Hi không an tâm là không an tâm chuyện gì và không an tâm chổ nào như thế nào hả ThuNghi,nói em biết để em liệu cơm gáp mấm
File ThuNghi đúng là không thỏa cụ thể là
1/ Nếu sét CK cho mặt hàng A còn từ B10 trở xuống để trống không có CK thì lúc này toàn bộ CK từ B10 trở xuống điều lấy CK của A500.
2/ Tương tự tình huống 1 nếu sét CK cho mặt hàng A và C còn B và các mặt hàng khác bỏ trống thì các mặt hàng đó điều lấy CK của mặt hàng cuối cùng nằm trên nó để làm CK cho nó
Sub CapNhatDmHH()
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False
End With
Dim endR As Long, i As Long
Dim CK2 As Double, CK3 As Double
Dim ArrMaHH(), ArrCK02(), ArrCK03()
Dim rngDM As Range, rngCK02 As Range, rngCK03 As Range
'xoa DMHH
With Sheets("DMHH").Range("A4")
endR = .Cells(1000, 2).End(xlUp).Row 'Lay theo cot tenHH'
.Resize(endR, 4).ClearContents 'Xoa DM
.Offset(, 7).Resize(endR, 1).ClearContents 'Xoa CK2'
.Offset(, 9).Resize(endR, 1).ClearContents 'Xoa CK3'
End With
With Sheets("BGia")
endR = .Cells(1000, 2).End(xlUp).Row 'Lay theo cot tenHH'
ArrMaHH = .Range("A8:D" & endR).Value
Set rngCK02 = .Range("E8:E" & endR) 'vung co gia 2'
Set rngCK03 = .Range("G8:G" & endR) 'vung co gia 3'
End With
endR = endR - 8 + 1: CK2 = 0: CK3 = 0
ReDim ArrCK02(1 To endR, 1 To 1), ArrCK03(1 To endR, 1 To 1)
For i = 1 To endR
'xet theo vung co CK2'
If rngCK02(i).MergeCells = True Then
If rngCK02(i) = 0 Then
CK2 = CK2
Else
CK2 = rngCK02(i)
End If
ArrCK02(i, 1) = CK2
Else
ArrCK02(i, 1) = rngCK02(i)
End If
'xet theo vung co CK3'
If rngCK03(i).MergeCells = True Then
If rngCK03(i) = 0 Then
CK3 = CK3
Else
CK3 = rngCK03(i)
End If
ArrCK03(i, 1) = CK3
Else
ArrCK03(i, 1) = rngCK03(i)
End If
Next i
'Gan lai vao DMHH
With Sheets("DMHH").Range("A4")
.Resize(endR, 4) = ArrMaHH 'Gan tenHH, Mhh..'
.Offset(, 7).Resize(endR, 1) = ArrCK02 'gan vao CK2'
.Offset(, 9).Resize(endR, 1) = ArrCK03 'gan vao CK3'
End With
Set rngDM = Nothing: Set rngCK02 = Nothing: Set rngCK03 = Nothing
Erase ArrMaHH(), ArrCK02(), ArrCK03()
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End SubRất cám ơn yêu cầu của bạn, nhờ vậy mình mới tầm sư học đạo và nhờ HD của NDU nên tôi viết thử code sau.
Option Explicit
Dim MyTmp02 As String, MyAdd02 As String, MyTmp03 As String, MyAdd03 As String
Dim endR As Long, r As Long
Dim ArrMaHH(), ArrCK02(), ArrCK03()
Dim rngDM As Range, rngCK02 As Range, rngCK03 As Range
Sub CapNhatDmHH()
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False
End With
'xoa DMHH'
With Sheets("DMHH").Range("A4")
endR = .Cells(1000, 2).End(xlUp).Row 'Lay theo cot tenHH'
.Resize(endR, 4).ClearContents 'Xoa DM'
.Offset(, 7).Resize(endR, 1).ClearContents 'Xoa CK2'
.Offset(, 9).Resize(endR, 1).ClearContents 'Xoa CK3'
End With
With Sheets("BGia")
endR = .Cells(1000, 2).End(xlUp).Row 'Lay theo cot tenHH'
ArrMaHH = .Range("A8:D" & endR).Value
Set rngCK02 = .Range("E8:E" & endR) 'vung co gia 2'
Set rngCK03 = .Range("G8:G" & endR) 'vung co gia 3'
End With
endR = endR - 8 + 1
ReDim ArrCK02(1 To endR, 1 To 1), ArrCK03(1 To endR, 1 To 1)
MyAdd02 = "": MyAdd03 = ""
For r = 1 To endR
'Phan CK2'
If rngCK02(r, 1).MergeCells Then
MyTmp02 = rngCK02(r, 1).MergeArea.Address
If InStr(MyAdd02, MyTmp02) = False Then
MyAdd02 = MyAdd02 & MyTmp02
ArrCK02(r, 1) = rngCK02(r, 1).Value
Else
ArrCK02(r, 1) = ArrCK02(r - 1, 1)
End If
Else
ArrCK02(r, 1) = rngCK02(r, 1).Value
End If
'Phan CK3'
If rngCK03(r, 1).MergeCells Then
MyTmp03 = rngCK03(r, 1).MergeArea.Address
If InStr(MyAdd03, MyTmp03) = False Then
MyAdd03 = MyAdd03 & MyTmp03
ArrCK03(r, 1) = rngCK03(r, 1).Value
Else
ArrCK03(r, 1) = ArrCK03(r - 1, 1)
End If
Else
ArrCK03(r, 1) = rngCK03(r, 1).Value
End If
Next r
With Sheets("BGIA")
.[J8].Resize(r - 1, 1) = ArrCK02
.[K8].Resize(r - 1, 1) = ArrCK03
End With
'Gan lai vao DMHH'
With Sheets("DMHH").Range("A4")
.Resize(endR, 4) = ArrMaHH 'Gan tenHH, Mhh..'
.Offset(, 7).Resize(endR, 1) = ArrCK02 'gan vao CK2'
.Offset(, 9).Resize(endR, 1) = ArrCK03 'gan vao CK3'
End With
Set rngDM = Nothing: Set rngCK02 = Nothing: Set rngCK03 = Nothing
Erase ArrMaHH(), ArrCK02(), ArrCK03()
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End SubWith Sheets("BGIA")
.[J8].Resize(r - 1, 1) = ArrCK02
.[K8].Resize(r - 1, 1) = ArrCK03
End WithSorry, bạn bỏ đi, do lúc làm để test nên quên bỏ.
Private Sub CommandButton2_Click() 'Tao Moi'
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Dim endR As Long, soHD As String
With Sheets("CTBan")
endR = .Cells(65000, 1).End(xlUp).Row
End With
If endR = 1 Then
TaoPBH
Else
LuuPBH
TaoPBH
End If
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End SubSub TaoSoPBH()
Set Sh = Sheets("CTBan")
With Sh
endR = .[B65500].End(xlUp).Row
Select Case endR
Case 1
soHD = "PX" & Right(Year(Date), 2) & Right("00" & Month(Date), 2) & "/" & "001"
Case Is > 1
soHD = .Cells(endR, 2).Value
If CLng(Mid(soHD, 3, 2)) = CLng(Right(Year(Date), 2)) Then
If CLng(Mid(soHD, 5, 2)) = CLng(Month(Date)) Then
soHD = "PX" & Right(Year(Date), 2) & Right("00" & Month(Date), 2) & "/" & Right("00" & Right(soHD, 3) + 1, 3)
Else
soHD = "PX" & Right(Year(Date), 2) & Right("00" & Month(Date), 2) & "/" & "001"
End If
End If
End Select
End With
Set Rng = Nothing: Set Sh = Nothing
End SubBạn check lại nhé, nếu có HD rồi thì chọn cancel, nó sẽ không lưu và tạo HD mới.
Có thêm bớt vài option nên code có dư vài chỗ, lúc nào rút gọn sau.
Quên mất TH2 này, cũng dễ thôi, mai làm, hình như TH1 làm rồi mà.
Bạn kiểm tra nhé. Cám ơn!
Nói chung là các code trong file trên gần như đầy đủ, cơ bản là bố trí và logich thế nào cho OK.
Private Sub KhachHang_Change()
Dim lstRes1
On Error Resume Next
Set Func = Application.WorksheetFunction
With Sheet4.Range(Sheet4.[C2], Sheet4.[C65536].End(xlUp))
Arr1 = Func.Transpose(.Cells)
End With
lstRes1 = Filter(Arr1, Me.KhachHang, True, vbTextCompare)
Me.KHList.List() = lstRes1
End Sub
