Cái này em chỉ mới làm chiều nay thôi, còn ai đã từng hỏi thì em chưa biết. Vậy sẳn bài này, Thầy đưa cái bài Thầy đã làm để tham khảo luôn đi Thầy nhé!
Làm đại 2 cách cách nào được thì lấy .
Phương án 1
PHP:
Function Function1(Str As String) As String
Dim Arr, i As Long, j As Long, Tmp, Count As Long
Arr = Split(Str, ", ")
For i = LBound(Arr) To UBound(Arr)
For j = i + 1 To UBound(Arr)
If CLng(Arr(j)) < CLng(Arr(i)) Then
Tmp = Arr(j): Arr(j) = Arr(i): Arr(i) = Tmp
End If
Next
Next
Tmp = Arr(LBound(Arr)): Count = 1: Str = ""
For i = LBound(Arr) + 1 To UBound(Arr)
If CLng(Arr(i)) = Tmp + Count Then
Count = Count + 1
Else
Str = Str & ", " & Tmp & IIf(Count > 1, "-" & (Tmp + Count - 1), "")
Tmp = CLng(Arr(i))
Count = 1
End If
Next
Str = Str & ", " & Tmp & IIf(Count > 1, "-" & (Tmp + Count - 1), "")
Function1 = Replace(Str, ", ", "", 1, 1)
End Function
Phương án 2
PHP:
Function Function2(Str As String) As String
Dim Arr, i As Long, j As Long, Tmp, Check As Boolean
On Error Resume Next
Arr = Split(Str, ", ")
For i = LBound(Arr) To UBound(Arr)
For j = i + 1 To UBound(Arr)
If CLng(Arr(j)) < CLng(Arr(i)) Then
Tmp = Arr(j): Arr(j) = Arr(i): Arr(i) = Tmp
End If
Next
If CLng(Arr(i)) = Arr(i - 1) + 1 Then
If Check Then
Arr(i - 1) = ""
Else
Arr(i - 1) = Arr(i - 1) & "-"
Check = True
End If
Else
Arr(i - 1) = Arr(i - 1) & ", "
Check = False
End If
Next
Function2 = Join(Arr, "")
End Function
*Anh ra đề bài như vậy --> chắc là để so sánh giải thuật
*Bài này mà anh đố theo kiểu : không dùng mảng, không dùng vòng lặp , chắc là em potay.com
Em dùng hàm tự tạo sau :
[GPECODE=vb]
Function Umsbala(str$) As String
Dim tmpArr, Arr(0 To 100)
Dim i&, j&, tmp$
tmpArr = Split(str, ",")
For i = 0 To UBound(tmpArr)
j = tmpArr(i)
Arr(j) = j
Next
For i = 0 To 100
If Len(Arr(i)) Then
For j = i + 1 To 100
If Len(Arr(j)) Then
If Len(Arr(j + 1)) Then
Arr(j) = ""
Else
Arr(j) = "-" & Arr(j) & ","
i = j
Exit For
End If
Else
Arr(i) = Arr(i) & ","
Exit For
End If
Next
End If
Next
tmp = Join(Arr, "")
Umsbala = Left(tmp, Len(tmp) - 1)
End Function
[/GPECODE]
[GPECODE=vb]
Sub Ktr()
MsgBox Umsbala("1, 8, 6, 4, 5, 11, 12, 13, 16, 15, 20, 14, 10, 7")
End Sub
[/GPECODE]
*Anh ra đề bài như vậy --> chắc là để so sánh giải thuật
*Bài này mà anh đố theo kiểu : không dùng mảng, không dùng vòng lặp , chắc là em potay.com
Em dùng hàm tự tạo sau :
Mã:
Function Umsbala(str$) As String
.....
[B]For i = 0 To [COLOR=#ff0000]100[/COLOR][/B]
dạ, số "đo đỏ" >= Max(Slpit(Str,",")) --> ý tưởng của em là sắp xếp mảng tăng dần ,dựa vào chỉ số của một mảng phụ , cụ thể:
*ta có mảng 1,2,10,16,20,4
* xây dựng một mảng phu: Arr(1) = 1, Arr(2) = 2,Arr(3) ="",...Arr(10) =10
* Cách sắp xếp này của em tiết kiệm "được" 1 vòng for..next, nhưng mà "mất" cái gì em cũng không biết
* Như vậy con số "đỏ đỏ"em chọn = 100 vì ví dụ anh nghĩa đưa ra có giả trị các con số < 100,
p/s : em xem lại thấy code em viết quả là "chuối củ "
*Anh ra đề bài như vậy --> chắc là để so sánh giải thuật
*Bài này mà anh đố theo kiểu : không dùng mảng, không dùng vòng lặp , chắc là em potay.com
Em dùng hàm tự tạo sau :
[GPECODE=vb]
Function Umsbala(str$) As String
Dim tmpArr, Arr(0 To 100)
Dim i&, j&, tmp$
tmpArr = Split(str, ",")
For i = 0 To UBound(tmpArr)
j = tmpArr(i)
Arr(j) = j
Next
For i = 0 To 100
If Len(Arr(i)) Then
For j = i + 1 To 100
If Len(Arr(j)) Then
If Len(Arr(j + 1)) Then
Arr(j) = ""
Else
Arr(j) = "-" & Arr(j) & ","
i = j
Exit For
End If
Else
Arr(i) = Arr(i) & ","
Exit For
End If
Next
End If
Next
tmp = Join(Arr, "")
Umsbala = Left(tmp, Len(tmp) - 1)
End Function
[/GPECODE]
[GPECODE=vb]
Sub Ktr()
MsgBox Umsbala("1, 8, 6, 4, 5, 11, 12, 13, 16, 15, 20, 14, 10, 7")
End Sub
[/GPECODE]
Ý tưởng của bạn cũng rất hay đấy, nếu sửa lại một chút là được, dùng cho trường hợp lược duy nhất:
Mã:
Function Umsbala(str$) As String
Dim tmpArr, [COLOR=#ff0000]Arr()[/COLOR], [COLOR=#0000cd]iMax As Long[/COLOR]
Dim i&, j&
tmpArr = Split(str, ",")
For i = 0 To UBound(tmpArr)
j = tmpArr(i)
[COLOR=#0000cd] If j > iMax Then iMax = j[/COLOR]
[COLOR=#ff0000] ReDim Preserve Arr(0 To iMax)[/COLOR]
Arr(j) = j
Next
For i = 0 To [COLOR=#0000cd]iMax[/COLOR]
If Len(Arr(i)) Then
For j = i + 1 To [COLOR=#0000cd]iMax[/COLOR]
If Len(Arr(j)) Then
If Len(Arr(j + 1)) Then
Arr(j) = ""
Else
Arr(j) = "-" & Arr(j) & ","
i = j
Exit For
End If
Else
Arr(i) = Arr(i) & ","
Exit For
End If
Next
End If
Next
[COLOR=#0000cd] Umsbala = Join(Arr, "")[/COLOR]
End Function
Đúng là như thế, nhưng nếu bạn làm như thế thì Thầy NDU chả phải góp ý cho bạn đâu hen. Cái hay của topic này là như vậy, đố để giải, giải để học, học qua học lại từ đó tất cả đều được học và đều tiến bộ là như thế đó.
Nếu có số trùng thì cả 2 code của tôi đang thực hiện theo hướng thứ 2. Còn nếu loại bỏ số trùng thì cũng đơn giản. Trong quá trình sắp xếp lại mảng, cái nào trùng thì bỏ ra. Ta sẽ được mảng duy nhất.
Nếu có số trùng thì cả 2 code của tôi đang thực hiện theo hướng thứ 2. Còn nếu loại bỏ số trùng thì cũng đơn giản. Trong quá trình sắp xếp lại mảng, cái nào trùng thì bỏ ra. Ta sẽ được mảng duy nhất.
Với bài này tôi muốn các bạn vận dụng CreateObject("MSScriptControl.ScriptControl") để sắp xếp dãy số, tuy nó chẳng mới mẽ gì, nhưng ít thấy ai sử dụng, nó không có vòng lặp nào cả, nhưng đảm bảo sắp xếp không sai tí nào cả. Còn ta dùng vòng lặp, chưa chắc đã đúng hết hoặc dùng rất nhiều vòng lặp để thực hiện.
Sau khi dùng nó, ta chỉ cần duyệt các số qua thêm 1 vòng lặp nữa thôi thì công việc đã hoàn tất rồi.
Đây là đáp án của mình:
[GPECODE=vb]
Function SummarySerries(ByVal SerStr As String, Optional ByVal Unique As Boolean = True) As String
Dim StrSplit As Variant, _
i As Long, LenTmp As Long, _
Item As String, Tmp As String
SerStr = Replace(SerStr, " ", "")
''SAP XEP LAI DAY SO TU NHO DEN LON:
SerStr = "('" & SerStr & "').split(',').sort(function(a,b){return(a-b)}).join(',')"
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JavaScript"
StrSplit = Split(.Eval(SerStr), ",")
End With
If Unique Then
''LUOC SO DUY NHAT:
For i = 0 To UBound(StrSplit)
Item = StrSplit(i)
If Item <> Tmp Then
If Tmp = "" Then
SummarySerries = SummarySerries & Item
Else
If Item - Tmp = 1 Then
SummarySerries = Replace(SummarySerries, "-" & Tmp, "") & "-" & Item
Else
SummarySerries = SummarySerries & ", " & Item
End If
End If
End If
Tmp = Item
Next
Else
''LUOC SO VAN DUY TRI SO TRUNG:
For i = 0 To UBound(StrSplit)
Item = StrSplit(i)
If Tmp = "" Then
SummarySerries = SummarySerries & Item
Else
If Item - Tmp = 1 Then
If InStr(Right(SummarySerries, Len(Tmp) + 1), "-") Then
LenTmp = Len(SummarySerries) - Len(Tmp) - 1
SummarySerries = Left(SummarySerries, LenTmp) & "-" & Item
Else
SummarySerries = SummarySerries & "-" & Item
End If
Else
SummarySerries = SummarySerries & ", " & Item
End If
End If
Tmp = Item
Next
End If
End Function
[/GPECODE]
Thủ tục:
Mã:
Sub XulyDaySo()
Dim SerStr As String
SerStr = "1,9,1,2,1,8,16,,,,4,3,11,11,9 ,,, ,5,11,12,13,,,,16,15,20,15,14,10,7,20"
Debug.Print SummarySerries(SerStr) 'Luoc duy nhat
Debug.Print SummarySerries(SerStr, 0) 'Khong duy nhat
End Sub
Function SummarySerries(ByVal SerStr As String, Optional ByVal Unique As Boolean = True) As String
Dim StrSplit As Variant, _
i As Long, LenTmp As Long, _
Item As String, Tmp As String
SerStr = Replace(SerStr, " ", "")
''SAP XEP LAI DAY SO TU NHO DEN LON:
SerStr = "('" & SerStr & "').split(',').sort(function(a,b){return(a-b)}).join(',')"
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JavaScript"
StrSplit = Split(.Eval(SerStr), ",")
End With
1 like cho Đoạn code : sắp xếp các số trong chuỗi từ lớn đến nhỏ, không cần dùng vòng lặp !
--> <---
Nhưng mà tại sao em gõ createObject("MSScriptControl.ScriptControl") --> lỗi ActiveX components can't create object
--> điều kiện sử dụng là gì vậy anh ? em dùng win 8 64 bits
Cũng lạ thật, mặc dù em References vào microsoft script control 1.0 và sửa thành "with new scriptcontrol" mà vẫn báo lỗi
không lẽ là do cái thằng script control này đang nằm ở thư mục C:\Window\sýsWOW64\mmscript.ocx
1 like cho Đoạn code : sắp xếp các số trong chuỗi từ lớn đến nhỏ, không cần dùng vòng lặp !
--> <---
Nhưng mà tại sao em gõ createObject("MSScriptControl.ScriptControl") --> lỗi ActiveX components can't create object
--> điều kiện sử dụng là gì vậy anh ? em dùng win 8 64 bits
vì Ram em 4G nên em mới cài 64 bits, em vừa ktra : win 64 là C:\Window\sýsWOW64\mmscript.ocx, còn 32 bits hình như là C:\Window\system32\mmscript.ocx , để em google thử xem ntn ?
ặc vừa search đã thấy : [NOTE1]The msscript component was not ported to 64 bit. It's a legacy component and MS chose not to put the effort into migrating it to 64 bit. You'll simply need to find another way to do whatever it is you do with that component.[/NOTE1]
Translate google : [NOTE1]Thành phần msscript không được chuyển đến 64 bit. Đó là một phần di sản và MS đã quyết định không đặt các nỗ lực vào di chuyển nó đến 64 bit. Bạn chỉ đơn giản là sẽ cần phải tìm một cách khác để làm bất cứ điều gì bạn làm với thàn[/NOTE1]
** Lại phải suy nghĩ về vụ Ram 4G nên cài 32 bits hay 64 bits và hình như cả DAO cũng không chạy trên 64bits !
vì Ram em 4G nên em mới cài 64 bits, em vừa ktra : win 64 là C:\Window\sýsWOW64\mmscript.ocx, còn 32 bits hình như là C:\Window\system32\mmscript.ocx , để em google thử xem ntn ?
[NOTE1]----- Original Message -----From: "Doug Lee" <doug.lee@xxxxxxxxxxxxxxxx>
To: <jawsscripts@xxxxxxxxxxxxx>
Sent: Saturday, April 20, 2013 11:54 PM
Subject: [jawsscripts] Re: CreateObject on 64 bit sistem
CreateObject functions should be able to work on 64-bit Windows, but you would need a 64-bit version of the object you want, I think. Some objects don't come in that flavor. For example, the MSScriptControl.ScriptControl object was, to my knowledge, never made available in a 64-bit environment.
On Sat, Apr 20, 2013 at 11:51:09PM +0200, Dragan Miljojcic wrote:
Hello,
Has anyone successfully used the Jaws function "CreateObjectEx" on a 64 bit system. It seems that Jaws14 on 64 bit system, do not create an object, while the same Jaws script works on 32 bit system. Do you have any experience with this. I will be very grateful for any response.
Với bài này tôi muốn các bạn vận dụng CreateObject("MSScriptControl.ScriptControl") để sắp xếp dãy số, tuy nó chẳng mới mẽ gì, nhưng ít thấy ai sử dụng, nó không có vòng lặp nào cả,
Sau khi dùng nó, ta chỉ cần duyệt các số qua thêm 1 vòng lặp nữa thôi thì công việc đã hoàn tất rồi.
Thế nếu bạn hungpecc1 sửa lại chút code rồi viết thành DLL nào đó rồi sau đó tôi dùng SUB của bạn ấy thì sao? Chả nhẽ tôi sẽ nói: "không dùng vòng lặp"? Thậm chí tôi còn hét lên: Thậm chí không cần "chỉ cần duyệt các số qua thêm 1 vòng lặp nữa thôi thì công việc đã hoàn tất rồi" mà có luôn "công việc đã hoàn tất"?
Nếu công việc bắt buộc phải "đóng đinh" thì phải đóng đinh, thế thôi. Bạn không phải đóng đinh chẳng qua là bạn "mượn" ai đó đóng định hộ bạn mà thôi. Cũng có thể bạn và không ai đóng định nhưng lúc đó thì để làm công việc bạn phải "vặn vít". Bạn không vặn thì có nghĩa là bạn "mượn" ai đó vặn. Mà bạn đừng khoe là không phải đóng đinh nhé. Vì lúc đó tôi sẽ khoe là tôi không phải vặn vít như bạn.
Công việc không tự nhiên sinh ra và cũng không tự nhiên mất đi. Nó chỉ "nhẩy" từ người này sang người khác. Bạn học định luật bảo toàn công việc chưa? He he.
.
và hình như cả DAO cũng không chạy trên 64bits !
