tieuvutru90
Thành viên mới
- Tham gia
- 16/4/10
- Bài viết
- 27
- Được thích
- 3
là mã mới không trùng với danh sách mã hàng hiện có đó Maika ơi!Không trùng là thế nào, chưa rõ lắm. Code này chỉ xử lý việc: mã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số
Bạn nói ở bài 1: "để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?"là mã mới không trùng với danh sách mã hàng hiện có đó Maika ơi!
lúc trước làm mã không chuẩn nên đôi khi đang BA102, BA103 cái nhảy lên BA400. giờ hàng mới về muốn nó tạo mã BA104 BA105, đại loại vậy đó!
Dữ liệu sheetJS không trùng, chạy sub ABCmã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số
mà em có danh sách một số mã hàng có sẵn rồi ạ. Có cách nào xài hàm VBA để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?
Xin được mọi người giúp đỡ ạ! Em xin cám ơn nhiều!
View attachment 259625
Option Explicit
Private mangBoDau(1 To 65535) As Integer
Sub ABC()
Dim Dic As Object, sArr(), Res(), sRow&, i&, j&, ma$, tmp$
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ma co san")
sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) <> Empty Then Dic.Item(sArr(i, 1)) = ""
Next i
With Sheets("SheetJS")
sArr = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
ReDim Res(1 To sRow, 1 To 1)
For i = 1 To sRow
If Len(sArr(i, 1)) > 1 Then
ma = BoDauViet(UCase(Mid(sArr(i, 1), 1, 2)))
For j = 1 To 1000000
tmp = ma & Format(j, "000")
If Dic.exists(tmp) = False Then
Res(i, 1) = tmp
Dic.Add tmp, ""
Exit For
End If
Next j
End If
Next i
Sheets("SheetJS").Range("C2").Resize(sRow, 1) = Res
End Sub
Function BoDauViet(ByVal Str As String) As String
Dim CodeKt, CodeDau, i&, C$
If mangBoDau(225) <> 97 Then
CodeKt = Array(97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, 105, 105, 105, 105, 105, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 121, 121, 121, 121, 121, 100)
CodeDau = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273)
For i = 0 To UBound(CodeKt)
mangBoDau(CodeDau(i)) = CodeKt(i)
Next i
End If
For i = 1 To Len(Str)
C = Mid(Str, i, 1)
If mangBoDau(AscW(LCase(C))) Then
If C = LCase(C) Then Mid(Str, i, 1) = ChrW(mangBoDau(AscW(C))) Else Mid(Str, i, 1) = UCase(ChrW(mangBoDau(AscW(LCase(C)))))
End If
Next i
BoDauViet = Str
End Function
2. Mã mới tạo ra buộc phải không trùng với bất kỳ mã hàng nào ở trong sheet "ma co san" của bạn.Bạn nói ở bài 1: "để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?"
Có 2 kiểu định nghĩa không trùng:
1. Mã mới tạo ra không trùng với mã cũ của cùng 1 mặt hàng. VD: Vitamin Vista-B B12: mã cũ VI004 mã mới tạo ra VI004 là không được, buộc phải là VI005 hay gì đó khác đi.
2. Mã mới tạo ra buộc phải không trùng với bất kỳ mã hàng nào ở trong sheet "ma co san" của bạn.
Muốn gì trình bày rõ, đừng hà tiện lời mà nói tối nghĩa. Mỗi cách định nghĩa là mỗi giải thuật khác nhau, đừng hời hợt quá!
Tuyệt vời quá bạn HieuCD ơi! Cám ơn nhiều! Nó giúp mình tiết kiệm rất nhiều thời gian và sức lực luôn đó! mê quá!Chạy sub ABC
Mã:Option Explicit Private mangBoDau(1 To 65535) As Integer Sub ABC() Dim Dic As Object, sArr(), Res(), sRow&, i&, j&, ma$, tmp$ Set Dic = CreateObject("Scripting.Dictionary") With Sheets("ma co san") sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value End With sRow = UBound(sArr) For i = 1 To sRow If sArr(i, 1) <> Empty Then Dic.Item(sArr(i, 1)) = "" Next i With Sheets("SheetJS") sArr = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value End With sRow = UBound(sArr) ReDim Res(1 To sRow, 1 To 1) For i = 1 To sRow If Len(sArr(i, 1)) > 1 Then ma = BoDauViet(UCase(Mid(sArr(i, 1), 1, 2))) For j = 1 To 1000000 tmp = ma & Format(j, "000") If Dic.exists(tmp) = False Then Res(i, 1) = tmp Dic.Add tmp, "" Exit For End If Next j End If Next i Sheets("SheetJS").Range("C2").Resize(sRow, 1) = Res End Sub Function BoDauViet(ByVal Str As String) As String Dim CodeKt, CodeDau, i&, C$ If mangBoDau(225) <> 97 Then CodeKt = Array(97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, 105, 105, 105, 105, 105, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 121, 121, 121, 121, 121, 100) CodeDau = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273) For i = 0 To UBound(CodeKt) mangBoDau(CodeDau(i)) = CodeKt(i) Next i End If For i = 1 To Len(Str) C = Mid(Str, i, 1) If mangBoDau(AscW(LCase(C))) Then If C = LCase(C) Then Mid(Str, i, 1) = ChrW(mangBoDau(AscW(C))) Else Mid(Str, i, 1) = UCase(ChrW(mangBoDau(AscW(LCase(C))))) End If Next i BoDauViet = Str End Function
STT | Nhóm hàng(3 Cấp) |
1 | cơ xương khớp |
2 | da liễu |
3 | dầu xoa, cao xoa |
4 | dầu xoa, cao xoa|cơ xương khớp |
5 | đông y |
6 | dược mỹ phẩm |
7 | dược mỹ phẩm|da liễu |
8 | gan, giải độc |
9 | giảm đau, hạ sốt |
10 | kháng sinh, nấm, virus, kí sinh trùng |
11 | kháng viêm, dị ứng |
12 | người việt dùng hàng việt |
13 | nhãn khoa |
14 | phụ khoa, nam khoa, nội tiết |
15 | tai, mũi, họng, hô hấp |
16 | thần kinh |
17 | thận, tiết niệu |
18 | thận, tiết niệu|tiêu hóa |
19 | thực phẩm bổ sung |
20 | tiêu hóa |
21 | tim mạch |
22 | TPCN |
23 | TPCN|người việt dùng hàng việt |
24 | TPCN|tim mạch|tiêu hóa |
25 | TPCN|vitamin và muối khoáng |
26 | vật tư y tế |
27 | vật tư y tế|tai, mũi, họng, hô hấp |
28 | vitamin và muối khoáng |
thật ra đây chỉ là bảng dữ liệu sau khi mình giới hạn lại để mn có thể tập trung hơn vào vấn đề mình đang gặp phải!Bạn có 3 cột, đó là [Loại hàng], [Nhóm Hàng] & [Mã Hàng]; # cột này chắc liên hệ với nhau không ít thì nhiều.
Cột [Loại Hàng] gác qua 1 bên vì nó đang trống huơ;
Cột thứ đến là nhóm hàng & sau khi mình tiến hành xóa trùng thì còn lại như vầy:
STT Nhóm hàng(3 Cấp) 1 cơ xương khớp 2 da liễu 3 dầu xoa, cao xoa 4 dầu xoa, cao xoa|cơ xương khớp 5 đông y 6 dược mỹ phẩm 7 dược mỹ phẩm|da liễu 8 gan, giải độc 9 giảm đau, hạ sốt 10 kháng sinh, nấm, virus, kí sinh trùng 11 kháng viêm, dị ứng 12 người việt dùng hàng việt 13 nhãn khoa 14 phụ khoa, nam khoa, nội tiết 15 tai, mũi, họng, hô hấp 16 thần kinh 17 thận, tiết niệu 18 thận, tiết niệu|tiêu hóa 19 thực phẩm bổ sung 20 tiêu hóa 21 tim mạch 22 TPCN 23 TPCN|người việt dùng hàng việt 24 TPCN|tim mạch|tiêu hóa 25 TPCN|vitamin và muối khoáng 26 vật tư y tế 27 vật tư y tế|tai, mũi, họng, hô hấp 28 vitamin và muối khoáng
(Trong đó có 4 dòng TFCN trùng nhau)
Theo mình nghĩ thì ta nên tạo mã nhóm hàng & mã này cho luôn vô [Mã Hàng]; Lúc đó các loại thuốc & hóa chất thuộc nhóm xương khớp đều có kí hiệu 'A' trong mã,. . . .
Bạn hiện có mã AB405 & kế đó là AC001; vậy xin hỏi bạn 'A' có nghĩa là gì & 'C' có nghĩa là chi?
Nên chăng 'A' là thần kinh, B là tim mạch, C là tiêu hóa & S là tiết niệu (?) . . . . . (Tất nhiên có loại đa chức năng, như nước cất hay vitamin,. . . . .)
Chỉnh lại sub ABC do dữ liệu trong SheetJS bị trùngTuyệt vời quá bạn HieuCD ơi! Cám ơn nhiều! Nó giúp mình tiết kiệm rất nhiều thời gian và sức lực luôn đó! mê quá!
Sub ABC()
Dim Dic As Object, sArr(), Res(), sRow&, i&, j&, ma$, tmp$
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
With Sheets("ma co san")
sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) <> Empty Then Dic.Item(sArr(i, 1)) = ""
Next i
With Sheets("SheetJS")
sArr = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
ReDim Res(1 To sRow, 1 To 1)
For i = 1 To sRow
If Len(sArr(i, 1)) > 1 Then
If Dic.exists(sArr(i, 1)) = False Then
ma = BoDauViet(UCase(Mid(sArr(i, 1), 1, 2)))
For j = 1 To 1000000
tmp = ma & Format(j, "000")
If Dic.exists(tmp) = False Then
Res(i, 1) = tmp
Dic.Add tmp, ""
Dic.Add sArr(i, 1), tmp
Exit For
End If
Next j
Else
Res(i, 1) = Dic.Item(sArr(i, 1))
End If
End If
Next i
Sheets("SheetJS").Range("C2").Resize(sRow, 1) = Res
End Sub
Thực ra tạo mã hàng như bạn chẳng có tác dụng gì.Nếu đã tạo thì mình phải tạo từ phân nhóm.Loại hàng hóa chứ ai lại lấy chữ cái đầu tiên đặt làm mã hàng.mã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số
mà em có danh sách một số mã hàng có sẵn rồi ạ. Có cách nào xài hàm VBA để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?
Xin được mọi người giúp đỡ ạ! Em xin cám ơn nhiều!
View attachment 259625
Tham khảo bài này nhé:mã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số
mà em có danh sách một số mã hàng có sẵn rồi ạ. Có cách nào xài hàm VBA để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?
Xin được mọi người giúp đỡ ạ! Em xin cám ơn nhiều!
View attachment 259625
Bạn biết dùng UserForm không? Nếu biết tôi bày cách cho bạn sử dụng mã tự động bằng code của tôi?Góp ý của mọi người về mã nên theo ngành hàng là rất đúng, em nghĩ sau này khi cơ sở dữ liệu hoàn thiện hơn chắc em sẽ bỏ 1 khoảng thời gian để làm lại mã hàng hóa! Code a HieuCD viết thì em sửa lại vị trí ô là sẽ dùng được!
Tạo cho bạn function nhập công thức trực tiếp trên sheet, bạn xem ví dụ trong sheetJS và sheet ma co sanmã hàng: 2 chữ cái đầu của tên hàng (không dấu, ký tự đặc biệt) + 3 số
mà em có danh sách một số mã hàng có sẵn rồi ạ. Có cách nào xài hàm VBA để nó tự xuất ra mã hàng mà không trùng với những mã hàng hiện tại không ạ?
Xin được mọi người giúp đỡ ạ! Em xin cám ơn nhiều!
Function ShortageID(ByVal strMa$, ByVal lenSTT&, ParamArray paArr()) As Variant
Dim aStt() As Boolean, Res(), jTem, sArr
Dim sRow&, n&, i&, k&, lenMa&, stt0$
lenMa = Len(strMa)
stt0 = String(lenSTT, "0")
ReDim aStt(1 To 1)
For Each sArr In paArr
If InStr(1, "RangeVariant()", TypeName(sArr)) = 0 Then sArr = Array(sArr)
For Each jTem In sArr
If Left(jTem, lenMa) = strMa Then
n = CLng(Right(jTem, lenSTT))
If n > UBound(aStt) - 1 Then ReDim Preserve aStt(1 To n + 1)
If aStt(n) = False Then
k = k + 1
aStt(n) = True
End If
End If
Next jTem
Next sArr
ReDim Res(1 To UBound(aStt) - k, 1 To 1)
If k Then
k = 0
For i = 1 To UBound(aStt)
If aStt(i) = False Then
k = k + 1
Res(k, 1) = strMa & Format(i, stt0)
End If
Next i
Else
Res(1, 1) = strMa & Format(1, stt0)
End If
ShortageID = Res
End Function
Xin anh cho một bài ví dụ bằng SheetForm được không anh NghĩaBạn biết dùng UserForm không? Nếu biết tôi bày cách cho bạn sử dụng mã tự động bằng code của tôi?
Trước hết để giải quyết triệt để vấn đề trùng mã, tôi thấy ngay cả tên hàng đã trùng 44 tên, nếu ghép với nhóm hàng thì trùng 43 tên, riêng cột nhóm hàng thì ô trống nhiều vô kể chúng ta cần loại trừ những tên hàng trùng nhau ra khỏi CSDL.là mã mới không trùng với danh sách mã hàng hiện có đó Maika ơi!
lúc trước làm mã không chuẩn nên đôi khi đang BA102, BA103 cái nhảy lên BA400. giờ hàng mới về muốn nó tạo mã BA104 BA105, đại loại vậy đó!