Nếu so sánh QR107 và QR26 có thể bạn cho rằng QR107 lớn hơn QR26 nhưng Excel nó không "nghĩ" vậy. Excel sẽ cho rằng QR107 nhỏ hơn QR26. Vậy tai sao bạn không theo luật của Excel? Thay vì QR26 bạn sửa thành QR026 thì có vấn đề gì không?
Function xapxep(ByVal dk As String) As String
Dim s As String, i As Long, t As String, arr, so, s1, j As Long
s = dk
For i = 1 To Len(s)
If IsNumeric(Mid(s, i, 1)) = False Then
t = t & Mid(s, i, 1)
Else
Exit For
End If
Next i
s = Replace(s, t, "")
arr = Split("," & s, ",")
For i = 1 To UBound(arr)
For j = UBound(arr) To i + 1 Step -1
If CLng(arr(j)) < CLng(arr(j - 1)) Then
so = arr(j)
arr(j) = arr(j - 1)
arr(j - 1) = so
End If
Next j
Next i
For i = 1 To UBound(arr)
s1 = s1 & "," & t & arr(i)
Next i
xapxep = Right(s1, Len(s1) - 1)
End Function
Nếu so sánh QR107 và QR26 có thể bạn cho rằng QR107 lớn hơn QR26 nhưng Excel nó không "nghĩ" vậy. Excel sẽ cho rằng QR107 nhỏ hơn QR26. Vậy tai sao bạn không theo luật của Excel? Thay vì QR26 bạn sửa thành QR026 thì có vấn đề gì không?
Em chào Anh ndu96081631,
Thực ra vấn đề này nó hơi dài một xíu, em trình bày ở dưới ạ.
Em có làm chương trình cho máy gắn linh kiện SMD, để làm được chương trình thì cần có một file gọi là BOM, trong file này thì có cột mô tả các vị trí linh kiện, R, C, QR, ... các vị trí này thì có BOM thì sắp theo thứ tự, có BOM thì không sắp xếp theo thứ tự,
Để làm được chương trình đổ lên cho máy chạy thì bên em có phần mềm chuyên làm chương trình, sau khi làm xong thì phần mềm sẽ xuất ra một dạng file .txt hoăc .csv,,, em phải dùng một VBA code nữa đổ gom lại thành một file với nhưng yêu cầu riêng, sau khi gom lại bằng VBA code thì các chuỗi tăng liên tục.
Do là chương trình để chạy nên yêu cầu, không được thêm bớt, sửa tên vị trí,
Bước làm chương trình cuối cùng là phải kiểm tra một số thông tin trong file được xuất ra từ phần mềm với file BOM nguyên thủy, xem có sai, thiếu sót gì không,
Có một số file BOM thì các vị trí được sắp theo thứ tự tăng dần, có file thì không, phần mềm xuất ra file thì luôn sắp xếp tăng dần,
Nếu tự sửa thành số như Anh nói thì lại không được, do quy định.
lâu nay, có một số trường hợp mặc dù, các chuỗi đảo nhau, nhưng vẫn đầy đủ thì không sao (đầy đủ số lượng vị trí), bên em chủ quan, không kiểm tra kĩ, cứ nghĩ là chỉ đảo vị trí, nhưng vừa rồi, có trường hợp, bị thiếu vị trí, không kiểm tra kĩ, em muốn chuyển về giống nhau để phần mềm so sánh cho chính xác và trực quan,
Cái file BOM check này, nếu giống nhau thì sẽ thông báo không có lỗi, nếu chỉ cần có sự khác biệt là sẽ hiện lên như hình em có đính kèm.
Trở lại với vấn đề, nếu Excel nó không "nghĩ" như vậy thì em sẽ hoặc kiểm tra bằng mắt từng cái một, hoặc dùng VBA code, lúc này, em vừa thấy có bạn "snow25" có gửi,
Em cảm ơn Anh rất nhiều.
Function xapxep(ByVal dk As String) As String Dim s As String, i As Long, t As String, arr, so, s1, j As Long s = dk For i = 1 To Len(s) If IsNumeric(Mid(s, i, 1)) = False Then t = t & Mid(s, i, 1) Else Exit For End If Next i s = Replace(s, t, "") arr = Split("," & s, ",") For i = 1 To UBound(arr) For j = UBound(arr) To i + 1 Step -1 If CLng(arr(j)) < CLng(arr(j - 1)) Then so = arr(j) arr(j) = arr(j - 1) arr(j - 1) = so End If Next j Next i For i = 1 To UBound(arr) s1 = s1 & "," & t & arr(i) Next i xapxep = Right(s1, Len(s1) - 1) End Function
Em chào Anh ndu96081631,
Thực ra vấn đề này nó hơi dài một xíu, em trình bày ở dưới ạ.
Em có làm chương trình cho máy gắn linh kiện SMD, để làm được chương trình thì cần có một file gọi là BOM, trong file này thì có cột mô tả các vị trí linh kiện, R, C, QR, ... các vị trí này thì có BOM thì sắp theo thứ tự, có BOM thì không sắp xếp theo thứ tự,
Để làm được chương trình đổ lên cho máy chạy thì bên em có phần mềm chuyên làm chương trình, sau khi làm xong thì phần mềm sẽ xuất ra một dạng file .txt hoăc .csv,,, em phải dùng một VBA code nữa đổ gom lại thành một file với nhưng yêu cầu riêng, sau khi gom lại bằng VBA code thì các chuỗi tăng liên tục.
Do là chương trình để chạy nên yêu cầu, không được thêm bớt, sửa tên vị trí,
Bước làm chương trình cuối cùng là phải kiểm tra một số thông tin trong file được xuất ra từ phần mềm với file BOM nguyên thủy, xem có sai, thiếu sót gì không,
Có một số file BOM thì các vị trí được sắp theo thứ tự tăng dần, có file thì không, phần mềm xuất ra file thì luôn sắp xếp tăng dần,
Nếu tự sửa thành số như Anh nói thì lại không được, do quy định.
lâu nay, có một số trường hợp mặc dù, các chuỗi đảo nhau, nhưng vẫn đầy đủ thì không sao (đầy đủ số lượng vị trí), bên em chủ quan, không kiểm tra kĩ, cứ nghĩ là chỉ đảo vị trí, nhưng vừa rồi, có trường hợp, bị thiếu vị trí, không kiểm tra kĩ, em muốn chuyển về giống nhau để phần mềm so sánh cho chính xác và trực quan, View attachment 246351
Cái file BOM check này, nếu giống nhau thì sẽ thông báo không có lỗi, nếu chỉ cần có sự khác biệt là sẽ hiện lên như hình em có đính kèm.
Trở lại với vấn đề, nếu Excel nó không "nghĩ" như vậy thì em sẽ hoặc kiểm tra bằng mắt từng cái một, hoặc dùng VBA code, lúc này, em vừa thấy có bạn "snow25" có gửi,
Em cảm ơn Anh rất nhiều.
Bài đã được tự động gộp:
Chào bạn snow25 nha, VBA code của bạn chạy ok rồi,
Cảm ơn bạn nha.
Hỏi lại lần nữa liên quan đến dữ liệu: Có bao giờ dữ liệu có dạng vầy không R53,C92,R72? Vừa có R lại vừa có C (hoặc nói chung là không cùng "bản chất")
--------------------------------------
Em chào Anh ndu96081631,
Thực ra vấn đề này nó hơi dài một xíu, em trình bày ở dưới ạ.
Em có làm chương trình cho máy gắn linh kiện SMD, để làm được chương trình thì cần có một file gọi là BOM, trong file này thì có cột mô tả các vị trí linh kiện, R, C, QR, ... các vị trí này thì có BOM thì sắp theo thứ tự, có BOM thì không sắp xếp theo thứ tự,
Để làm được chương trình đổ lên cho máy chạy thì bên em có phần mềm chuyên làm chương trình, sau khi làm xong thì phần mềm sẽ xuất ra một dạng file .txt hoăc .csv,,, em phải dùng một VBA code nữa đổ gom lại thành một file với nhưng yêu cầu riêng, sau khi gom lại bằng VBA code thì các chuỗi tăng liên tục.
Do là chương trình để chạy nên yêu cầu, không được thêm bớt, sửa tên vị trí,
Bước làm chương trình cuối cùng là phải kiểm tra một số thông tin trong file được xuất ra từ phần mềm với file BOM nguyên thủy, xem có sai, thiếu sót gì không,
Có một số file BOM thì các vị trí được sắp theo thứ tự tăng dần, có file thì không, phần mềm xuất ra file thì luôn sắp xếp tăng dần,
Nếu tự sửa thành số như Anh nói thì lại không được, do quy định.
lâu nay, có một số trường hợp mặc dù, các chuỗi đảo nhau, nhưng vẫn đầy đủ thì không sao (đầy đủ số lượng vị trí), bên em chủ quan, không kiểm tra kĩ, cứ nghĩ là chỉ đảo vị trí, nhưng vừa rồi, có trường hợp, bị thiếu vị trí, không kiểm tra kĩ, em muốn chuyển về giống nhau để phần mềm so sánh cho chính xác và trực quan, View attachment 246351
Cái file BOM check này, nếu giống nhau thì sẽ thông báo không có lỗi, nếu chỉ cần có sự khác biệt là sẽ hiện lên như hình em có đính kèm.
Trở lại với vấn đề, nếu Excel nó không "nghĩ" như vậy thì em sẽ hoặc kiểm tra bằng mắt từng cái một, hoặc dùng VBA code, lúc này, em vừa thấy có bạn "snow25" có gửi,
Em cảm ơn Anh rất nhiều.
Bài đã được tự động gộp:
Chào bạn snow25 nha, VBA code của bạn chạy ok rồi,
Cảm ơn bạn nha.
Private Sub SortAny_test()
Debug.Print SortAny("R6,R2,T5")
End Sub
Function SortAny(ByVal Text As String) As String
Dim A(), B(), i&, j&, L&, t$, S$, E$, F&, M&
SortAny = Text
L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then
E = E & S
ElseIf S Like "#" Then
E = E & S: F = F * 10 + CInt(S)
Else
GoTo E
End If
If i = L And E <> "" And F > 0 Then
E: j = j + 1
If F > M Then M = F: ReDim Preserve A(M)
A(F) = E
E = "": F = 0
End If
Next
t = Trim(Join(A, " "))
While t Like "* *"
t = Replace(t, " ", "")
Wend
SortAny = Replace(t, " ", ",")
End Function
Private Sub SortAny2_test()
Debug.Print SortAny2("R6,R2,T5")
End Sub
Function SortAny2(ByVal Text As String, Optional ByVal Descending As Boolean) As String
Dim RE As Object, MS As Object, A(), B(), i&, j&, L&, t
Set RE = VBA.CreateObject("VBScript.RegExp")
SortAny2 = Text
With RE
.Global = True
.pattern = "([A-z]*)(\d+)"
Set MS = .Execute(Text)
If MS.Count > 1 Then
L = MS.Count - 1
ReDim A(L): ReDim B(L)
For i = 0 To L
A(i) = MS(i).SubMatches(1): B(i) = MS(i)
Next
For i = 0 To L
For j = i + 1 To L
If (Descending And A(i) < A(j)) Or (Not Descending And A(i) > A(j)) Then
t = A(i): A(i) = A(j): A(j) = t
t = B(i): B(i) = B(j): B(j) = t
End If
Next
Next
SortAny2 = Join(B, ",")
End If
End With
Set RE = Nothing
End Function
Private Sub SortAny3_test()
Debug.Print SortAny3("R6,R2,T5")
End Sub
Function SortAny3(ByVal Text As String, Optional ByVal Descending As Boolean) As String
Dim A(), B(), i&, j&, L&, t, S$, E$, F$
SortAny3 = Text
L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then
E = E & S
ElseIf S Like "#" Then
E = E & S: F = F & S
Else
GoTo E
End If
If i = L And E <> "" And F <> "" Then
E: j = j + 1
ReDim Preserve A(1 To j): A(j) = F
ReDim Preserve B(1 To j): B(j) = E
E = "": F = ""
End If
Next
If j > 1 Then
L = j
For i = 1 To L
For j = i + 1 To L
If (Descending And A(i) < A(j)) Or (Not Descending And A(i) > A(j)) Then
t = A(i): A(i) = A(j): A(j) = t
t = B(i): B(i) = B(j): B(j) = t
End If
Next
Next
SortAny3 = Join(B, ",")
End If
End Function
Private Sub SortAny_test()
Debug.Print SortAny("R6,R2,T5")
End Sub
Function SortAny(ByVal Text As String) As String
Dim A(), B(), i&, j&, L&, t$, S$, E$, F&, M&
SortAny = Text
L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then
E = E & S
ElseIf S Like "#" Then
E = E & S: F = F * 10 + CInt(S)
Else
GoTo E
End If
If i = L And E <> "" And F > 0 Then
E: j = j + 1
If F > M Then M = F: ReDim Preserve A(M)
A(F) = E
E = "": F = 0
End If
Next
t = Trim(Join(A, " "))
While t Like "* *"
t = Replace(t, " ", "")
Wend
SortAny = Replace(t, " ", ",")
End Function
Private Sub SortAny2_test()
Debug.Print SortAny2("R6,R2,T5")
End Sub
Function SortAny2(ByVal Text As String, Optional ByVal Descending As Boolean) As String
Dim RE As Object, MS As Object, A(), B(), i&, j&, L&, t
Set RE = VBA.CreateObject("VBScript.RegExp")
SortAny2 = Text
With RE
.Global = True
.pattern = "([A-z]*)(\d+)"
Set MS = .Execute(Text)
If MS.Count > 1 Then
L = MS.Count - 1
ReDim A(L): ReDim B(L)
For i = 0 To L
A(i) = MS(i).SubMatches(1): B(i) = MS(i)
Next
For i = 0 To L
For j = i + 1 To L
If (Descending And A(i) < A(j)) Or (Not Descending And A(i) > A(j)) Then
t = A(i): A(i) = A(j): A(j) = t
t = B(i): B(i) = B(j): B(j) = t
End If
Next
Next
SortAny2 = Join(B, ",")
End If
End With
Set RE = Nothing
End Function
Private Sub SortAny3_test()
Debug.Print SortAny3("R6,R2,T5")
End Sub
Function SortAny3(ByVal Text As String, Optional ByVal Descending As Boolean) As String
Dim A(), B(), i&, j&, L&, t, S$, E$, F$
SortAny3 = Text
L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then
E = E & S
ElseIf S Like "#" Then
E = E & S: F = F & S
Else
GoTo E
End If
If i = L And E <> "" And F <> "" Then
E: j = j + 1
ReDim Preserve A(1 To j): A(j) = F
ReDim Preserve B(1 To j): B(j) = E
E = "": F = ""
End If
Next
If j > 1 Then
L = j
For i = 1 To L
For j = i + 1 To L
If (Descending And A(i) < A(j)) Or (Not Descending And A(i) > A(j)) Then
t = A(i): A(i) = A(j): A(j) = t
t = B(i): B(i) = B(j): B(j) = t
End If
Next
Next
SortAny3 = Join(B, ",")
End If
End Function
Private Sub SortAny5_test()
Debug.Print SortAny5("R6,R2,T5,A1")
End Sub
Function SortAny5(ByVal Text As String) As String
Dim R As Object, S As Object, A(), i&, M&, t&
Set R = VBA.CreateObject("VBScript.RegExp")
SortAny5 = Text
With R
.Global = 1
.pattern = "([A-z]*)(\d+)"
Set S = .Execute(Text)
If S.Count > 1 Then
For i = 0 To S.Count - 1
t = S(i).SubMatches(1)
If t > M Then M = t: ReDim Preserve A(M)
A(t) = S(i)
Next
.pattern = " +"
SortAny5 = .Replace(Trim(Join(A, " ")), ",")
End If
End With
Set R = Nothing
Set S = Nothing
End Function
JavaScript:
Function sortAny6(text$, Optional ByVal delimiter$ = ",", Optional ByVal Descending As Boolean)
Static o As Object
If o Is Nothing Then
Set o = VBA.CreateObject("htmlfile")
With o.parentWindow
.execScript "function SortByNumberOfString(text, delimiter, descending){" & _
" var s = text.split(delimiter);" & _
" var t;" & _
" var c = function (a, b) {" & _
" if (!descending==0) {t=a; a=b;b=t}" & _
" return (Number(a.match(/(\d+)/g)[0]) - Number((b.match(/(\d+)/g)[0])));" & _
" };" & _
" return s.sort(c).join(delimiter);" & _
"}", "javaScript"
End With
End If
sortAny6 = o.parentWindow.SortByNumberOfString(text, delimiter, CInt(Descending))
End Function
Private Sub SortAny5_test()
Debug.Print SortAny5("R6,R2,T5,A1")
End Sub
Function SortAny5(ByVal Text As String) As String
Dim R As Object, S As Object, A(), i&, M&, t&
Set R = VBA.CreateObject("VBScript.RegExp")
SortAny5 = Text
With R
.Global = 1
.pattern = "([A-z]*)(\d+)"
Set S = .Execute(Text)
If S.Count > 1 Then
For i = 0 To S.Count - 1
t = S(i).SubMatches(1)
If t > M Then M = t: ReDim Preserve A(M)
A(t) = S(i)
Next
.pattern = " +"
SortAny5 = .Replace(Trim(Join(A, " ")), ",")
End If
End With
Set R = Nothing
Set S = Nothing
End Function
JavaScript:
Function sortAny6(text$, Optional ByVal delimiter$ = ",", Optional ByVal Descending As Boolean)
Static o As Object
If o Is Nothing Then
Set o = VBA.CreateObject("htmlfile")
With o.parentWindow
.execScript "function SortByNumberOfString(text, delimiter, descending){" & _
" var s = text.split(delimiter);" & _
" var t;" & _
" var c = function (a, b) {" & _
" if (!descending==0) {t=a; a=b;b=t}" & _
" return (Number(a.match(/(\d+)/g)[0]) - Number((b.match(/(\d+)/g)[0])));" & _
" };" & _
" return s.sort(c).join(delimiter);" & _
"}", "javaScript"
End With
End If
sortAny6 = o.parentWindow.SortByNumberOfString(text, delimiter, CInt(Descending))
End Function
Em chao Anh huuthang_bd,
Đúng thật là Code trên em không sử dụng được, Anh ndu96081631 có chia sẻ là không sử dụng được trên Windows 64bits ạ,
Em cảm ơn Anh.
Hỏi lại lần nữa liên quan đến dữ liệu: Có bao giờ dữ liệu có dạng vầy không R53,C92,R72? Vừa có R lại vừa có C (hoặc nói chung là không cùng "bản chất")
--------------------------------------
Đoán là code này không chạy được trên Office 64 bit
Em chào Anh ndu96081631,
Dữ liệu dạng đan xen tên khác nhau, thực sự là bên em chạy cũng gần 3000 chương trình, nhưng mới chỉ gặp được khoảng 2 hoặc 3 chương trình có trường hợp trên thôi ạ, còn lại là tên theo quy luật, một kí tự đại diện cho tên linh kiện.
Em có đính kèm một file BOM và các file .txt xuất sau khi làm chương trình để tham khảo ạ.
Còn Code của Anh huuthang_bd, lúc em để vô kiểm tra, thấy không chạy được, nên cũng chưa biết lý do, Cảm ơn Anh chia sẻ thông tin.
Private Sub SortAny5_test()
Debug.Print SortAny5("R6,R2,T5,A1")
End Sub
Function SortAny5(ByVal Text As String) As String
Dim R As Object, S As Object, A(), i&, M&, t&
Set R = VBA.CreateObject("VBScript.RegExp")
SortAny5 = Text
With R
.Global = 1
.pattern = "([A-z]*)(\d+)"
Set S = .Execute(Text)
If S.Count > 1 Then
For i = 0 To S.Count - 1
t = S(i).SubMatches(1)
If t > M Then M = t: ReDim Preserve A(M)
A(t) = S(i)
Next
.pattern = " +"
SortAny5 = .Replace(Trim(Join(A, " ")), ",")
End If
End With
Set R = Nothing
Set S = Nothing
End Function
JavaScript:
Function sortAny6(text$, Optional ByVal delimiter$ = ",", Optional ByVal Descending As Boolean)
Static o As Object
If o Is Nothing Then
Set o = VBA.CreateObject("htmlfile")
With o.parentWindow
.execScript "function SortByNumberOfString(text, delimiter, descending){" & _
" var s = text.split(delimiter);" & _
" var t;" & _
" var c = function (a, b) {" & _
" if (!descending==0) {t=a; a=b;b=t}" & _
" return (Number(a.match(/(\d+)/g)[0]) - Number((b.match(/(\d+)/g)[0])));" & _
" };" & _
" return s.sort(c).join(delimiter);" & _
"}", "javaScript"
End With
End If
sortAny6 = o.parentWindow.SortByNumberOfString(text, delimiter, CInt(Descending))
End Function
Em chào Anh ndu96081631,
Dữ liệu dạng đan xen tên khác nhau, thực sự là bên em chạy cũng gần 3000 chương trình, nhưng mới chỉ gặp được khoảng 2 hoặc 3 chương trình có trường hợp trên thôi ạ, còn lại là tên theo quy luật, một kí tự đại diện cho tên linh kiện.
Em có đính kèm một file BOM và các file .txt xuất sau khi làm chương trình để tham khảo ạ.
Còn Code của Anh huuthang_bd, lúc em để vô kiểm tra, thấy không chạy được, nên cũng chưa biết lý do, Cảm ơn Anh chia sẻ thông tin.
Em có đính kèm thêm cái file "Check BOM & FSS" File này dùng để kiểm tra như em có nói ở bài trên rồi Anh ạ.
Do còn bị hạn chế, có thể là tầm nhìn sự hiểu biết về Excel nên để làm một chương trình chạy hoàn chỉnh trên dây chuyền bên em vẫn còn làm theo nhiều bước quá.
Nhưng vướng ở đâu, gỡ ở đó, em Cảm ơn các Anh trong diễn đàn.
@thehoang7
Thủ tục SortAny #9 sai đoạn dưới
t = Replace(t, " ", "") sửa thành t = Replace(t, " ", " ")
------------------
JavaScript:
Function SortAny(ByVal Text As String) As String
Dim A(), B(), i&, L&, S$, E$, F&, M&
SortAny = Text: L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then E = E & S Else If S Like "#" Then F = F * 10 + CInt(S) Else GoTo E
If i = L And E <> "" And F > 0 Then
E: If F > M Then M = F: ReDim Preserve A(M)
A(F) = E & CStr(F): E = "": F = 0
End If
Next
SortAny = Replace(Application.Trim(Join(A, " ")), " ", ",")
End Function
@thehoang7
Thủ tục SortAny #9 sai đoạn dưới
t = Replace(t, " ", "") sửa thành t = Replace(t, " ", " ")
------------------
JavaScript:
Function SortAny(ByVal Text As String) As String
Dim A(), B(), I&, L&, S$, E$, F&, M&
SortAny = Text: L = Len(Text)
For i = 1 To L
S = Mid(Text, i, 1)
If S Like "[A-z]" Then E = E & S Else If S Like "#" Then F = F * 10 + CInt(S) Else GoTo E
If i = L And E <> "" And F > 0 Then
E: If F > M Then M = F: ReDim Preserve A(M)
A(F) = E & CStr(F): E = "": F = 0
End If
Next
S = Trim(Join(A, " "))
While S Like "* *": S = Replace(S, " ", " "): Wend
SortAny = Replace(S, " ", ",")
End Function
