Liệt kê toàn bộ các số điện thoại đẹp lên trang tính. (4 người xem)

[hoangvuluan]

(Marco của BoyXin+ tốc độ chạy cực nhanh, test trên máy của tôi có thời gian = 0)
Hàm kiểm tra 8 số đôi một khác nhau:
Len(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace
("0123456789", t, ""), w, ""), e, ""), n, ""), y, ""), i, ""), g, ""), h, "")) = 2

 

[SA_DQ]

Các bạn giải giúp bài thứ 12, như sau

Tôi có một số ngẫu nhiên gồm 6 chữ số, ví dụ 109872
Viết giúp tôi macro để xác định số lớn nhất có thể từ các ký số trên
Đáp án macro sẽ là 987210
Xin cảm ơn các bạn đã & đang quan tâm!

 [/COLOR]
[COLOR=white] Randomize
 Tong = 999999 - Int(8 * Rnd * 10 ^ 5)
[/COLOR]
[COLOR=white]

 

[hoangvuluan]

Dùng hàm:

Function NumSort(ByVal n) As String
Dim s As String, i As Byte, j As Byte, k As Byte
Dim a(0 To 9) As Byte
    s = ""
    For i = 1 To Len(n)
        k = Mid(n, i, 1) + 0        
        a(k) = a(k) + 1
    Next
    For i = 0 To 9
        If a(i) > 0 Then
            For j = 1 To a(i)
                s = i & s
            Next
        End If
    Next
    NumSort = s
End Function

Nếu thích thì chuyển sang marco nhé!

 

[SA_DQ]

Thật là một tuyệt chiêu lần đầu tiên được thấy về biến mảng.

     a(k) = a(k) + 1

Rất cảm ơn HoangVuLam về hàm này!
(Để khỏi mang tội spam, xin bịa thêm bài 13, như là dẫn xuất từ bài kế trên
Bài 13: Từ các ký số của số có 6 chữ số ngẫu nhiên như trên; Hãy xác lập số nhỏ nhất có thể từ các ký số trên.
Như ví dụ bên trên sẽ là: 102789

Rất cảm ơn các bạn quan tâm!

 

[hoangvuluan]

Sắp thứ tự

Chào bạn!
Cái này:

     a(k) = a(k) + 1

là giải thuật cơ bản của kỹ thuật đếm phân phối mà tôi học được từ hồi học Pascal.

Trong hàm NumSort, dòng lệnh: s = i & s
là kỹ thuật nối sau, làm cho chuỗi kết quả sắp thứ tự giảm dần, nếu ta đảo lại thành nối trước: s = s & i
thì nhận được chuỗi sắp tăng dần, chính là yêu cầu ở Bài 13 của Bạn:

Bài 13: Từ các ký số của số có 6 chữ số ngẫu nhiên như trên; Hãy xác lập số nhỏ nhất có thể từ các ký số trên.
Như ví dụ bên trên sẽ là: 102789

Thân!
Rất cảm ơn các bạn quan tâm![/quote]

 

[SA_DQ]

Không xử lý con '0' ư bạn?!

Mình nghĩ là phải xử lý thêm chút nữa mới đạt
Ví sẽ là 102789 chứ không phải 012789. Con số sau chỉ mới là con số có 5 chữ số mà thôi!

 

[hoangvuluan]

Số nhỏ nhất

Mình nghĩ là phải xử lý thêm chút nữa mới đạt
Ví sẽ là 102789 chứ không phải 012789. Con số sau chỉ mới là con số có 5 chữ số mà thôi!

Nếu thế thì đề bài nên viết là:
Bài 13: Từ tập các ký số của số có n chữ số, hãy xác lập số nhỏ nhất có n chữ số tạo thành từ tập các ký số trên.

và có thể điều chỉnh kết quả như sau:

Function NumSortD(ByVal n) As String
Dim s As String, i As Byte, j As Byte, k As Byte
Dim a(0 To 9) As Byte
    n = CStr(n)
    s = ""
    For i = 1 To Len(n)
        k = Mid(n, i, 1) + 0
        a(k) = a(k) + 1
    Next
    For i = 1 To 9
        If a(i) > 0 Then
            For j = 1 To a(i)
                s = s & i
            Next
        End If
    Next
    NumSortD = Left(s, 1) & IIf(a(0) > 0, String(Len(n)-Len(s), "0"), "") & Right(s, Len(s)-1)
End Function

 

[SA_DQ]

Số 220
Tổng các ước số của nó là:
1 + 2 + 4 + 5 + 10 + 11 + 20 + 22 + 44 + 55 + 110 = 284
Với số 284
Sẽ có tổng các ước số là:
1 + 2 + 4 + 71 + 142 = 220
Chúng rất thương nhau, phải không các bạn!

Bài 14: Hãy tìm & ghi lên trang tính các cặp thương nhau của các số có 6 chữ số giúp tôi với. Rất cảm ơn các bạn vì macro sắp tới!

1. 220 có tính là ước của 220 không?
2. 284 có tính là ước của 284 không?

Sao không thấy bác cộng vào nhỉ?

Không tính mà! Nếu tính thì chắc chúng không thương nhau rồi!

 

[SA_DQ]

Xin các bạn góp ý để tăng tốc bài giải 14

Chỉ xét trên 1/5 đoạn đường phải đi nhưng đã mất hơn 3 phút
Rất mong nhận được những ý kiến góp ý để ngỏ hầu tăng tốc

Option Explicit
Sub UocSo220()
 Dim jJ As Long, Ww As Long, Tg2 As Long, Tong As Long
 Dim Rng As Range, sRng As Range
 
 Application.ScreenUpdating = False
 For Ww = 100000 To 126789
    Set Rng = Range("b2:B" & [b65500].End(xlUp).Row)
    Set sRng = Rng.Find(what:=Ww, LookIn:=xlFormulas, lookat:=xlWhole)
    If Not sRng Is Nothing Then GoTo GPE_COM
    For jJ = 2 To Ww
        If Ww Mod jJ = 0 Then _
            Tong = Tong + Ww / jJ
    Next jJ
    For jJ = 2 To Tong
        If Tong Mod jJ = 0 Then _
            Tg2 = Tg2 + Tong / jJ
    Next jJ
    If Tg2 = Ww Then
        With [a65500].End(xlUp)
            .Offset(1) = Ww:        .Offset(1, 1) = Tong
        End With
    Else
        Tong = 0:       Tg2 = 0
    End If
GPE_COM: Next Ww
End Sub

Kết quả:

|A | B |C |
|100 485 | 124 155|
| 122 265 | 139 815 |
|122 368 | 123 152 |
|. . . .|. . . .|

 

[boyxin]

Chỉ xét trên 1/5 đoạn đường phải đi nhưng đã mất hơn 3 phút
Rất mong nhận được những ý kiến góp ý để ngỏ hầu tăng tốc

Option Explicit
Sub UocSo220()
 Dim jJ As Long, Ww As Long, Tg2 As Long, Tong As Long
 Dim Rng As Range, sRng As Range
 
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
[f1] = Timer: [a1].CurrentRegion.ClearContents
 For Ww = 2 To 10000
    Set Rng = Range("b2:B" & [b65500].End(xlUp).Row)
    Set sRng = Rng.Find(what:=Ww, LookIn:=xlFormulas, lookat:=xlWhole)
    If Not sRng Is Nothing Then GoTo GPE_COM
    For jJ = 2 To Ww
        If Ww Mod jJ = 0 Then _
            Tong = Tong + Ww / jJ
    Next jJ
    For jJ = 2 To Tong
        If Tong Mod jJ = 0 Then _
            Tg2 = Tg2 + Tong / jJ
    Next jJ
    If Tg2 = Ww Then
        With [a65500].End(xlUp)
            .Offset(1) = Ww:        .Offset(1, 1) = Tong
        End With
    Else
        Tong = 0:       Tg2 = 0
    End If
GPE_COM: Next Ww
[g1] = Timer: [h1] = [g1] - [f1]
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

Test thử từ 2 đến 10 000: Total = 9.015625" trong đó có các cặp (7 & 7), (29 & 29), (30 & 71) hình như là không đúng
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
Em đưa ra giải pháp như sau: Test thử từ 2 đến 10 000: Total = 3.8125"

Sub Bai14()
Dim n As Long, s1 As Long, s2 As Long, i As Long, j As Long
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
[f1] = Timer: [a1].CurrentRegion.ClearContents
For n = 2 To 10000
Set clls = Range([b2], [b2].End(xlDown)).Find(what:=n)
If Not clls Is Nothing Then
    With [a65535].End(xlUp)
        .Offset(1) = n: .Offset(1, 1) = clls.Offset(, -1).Value
    End With
Else
    s1 = 1: s2 = 1: s11 = "1": s21 = "1"
    If SoNT(n) = False Then
        For i = 2 To n / Uoc_NN(n)
            If n Mod i = 0 Then s1 = s1 + i
        Next
        If SoNT(s1) = False Then
            For j = 2 To s1 / Uoc_NN(s1)
                If s1 Mod j = 0 Then s2 = s2 + j
            Next
            If n = s2 Then
                With [a65535].End(xlUp)
                    .Offset(1) = n: .Offset(1, 1) = s1
                End With
            End If
        End If
    End If
End If
Next
[g1] = Timer: [h1] = [g1] - [f1]
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub
Function SoNT(So As Long) As Boolean
Dim n As Long
    If So < 2 Or (So <> 2 And So Mod 2 = 0) Or So <> Int(So) Then Exit Function
    If So = 3 Or So = 2 Then SoNT = True: Exit Function
    Select Case So Mod 6
         Case 1, 5
         For n = 5 To Sqr(So) Step 6
             If So Mod n = 0 Or So Mod n + 2 = 0 Then Exit Function
         Next n
    Case Else
        Exit Function
    End Select
    SoNT = True
End Function
Function Uoc_NN(So As Long) As Long
Dim n As Long
    For n = 2 To So
        If So Mod n = 0 Then Exit For
    Next
Uoc_NN = n
End Function

Các bác kiểm tra giúp xem còn sai sót gì không?

 

[SA_DQ]

Một cách khác để tìm số nguyên tố

BoyXin xem thử có thể sửa & kiểm lại tốc độ tìm số nguyên tố theo định nghĩa sau:
Nếu GPE là số nguyên tố lớn hơn 3, thì GPE^2 - 1 là bội số của 24
Chứng minh:
Một số nguyên tố lúc nào cũng có dạng:
SNT = bội số của 4 (+/-) 1 = Bội số của 6 (+/-) 1
SNT = ( Bội số của 4 cộng trừ 1) = ( Bội số của 6 cộng trừ 1)
Mà GPE^2 - 1 = (GPE -1) (GPE + 1) => GPE = bội số của 24;

 

[hoangvuluan]

Bài này tôi tính chỉ có 27 cặp số - Không biết có sai gì không, các bạn kiểm tra giúp:

' Hàm tính tổng các ước '
Private Function uSum(So As Long) As Long
Dim s As Long, i As Long
    s = 1
    For i = 2 To Int(Sqr(So))
        If (So Mod i = 0) Then s = s + i + IIf(i ^ 2 <> So, So \ i, 0)
    Next
    uSum = s
End Function

' ========================== '
' Liệt kê các cặp số 6 chữ số (a, b), '
' sao cho tổng các ước của a (không kể chính nó) là b và ngược lại '
' ========================== '
 
Sub Bai_14() 
Dim c As Long, r As Long, r0 As Long, ks As Long, sk As Long, x As Long
Dim a, Rng As Range
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    [D1] = Timer
    Set Rng = [A1:B100] ' dieu chinh sau khi da test
    Rng.ClearContents
    r0 = 0
    For r = 100000 To 999999
        ks = uSum(r)
        If Len(ks & "") = 6 Then
            sk = uSum(ks)
            If (sk = r) Then
                If WorksheetFunction.CountIf(Rng, r) = 0 Then
                    r0 = r0 + 1
                    Cells(r0, 1) = r
                    Cells(r0, 2) = ks
                End If
            End If
        End If
    Next r
    [E1] = Timer: [F1] = [E1] - [D1]
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

 

[ChanhTQ@]

Test thử từ 2 đến 10 000: Total = 9.015625" trong đó có các cặp (7 & 7), (29 & 29), (30 & 71) hình như là không đúng
' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * '
Em đưa ra giải pháp như sau: Test thử từ 2 đến 10 000: Total = 3.8125"
. . . . .
Các bác kiểm tra giúp xem còn sai sót gì không?

Kết quả trên máy của mình về thời gian: 1.548875
Nhưng vẫn còn những điều chưa hết ý cho lắm; Như sau:

* Kết quả:

| A | B |C |
| 6 | 6 | |
| 28 | 28 | |
| 220 | 284 | |
| 284 | 220 | |
| 496 | 496 | |
| 1184 | 1210 |<-Tr |
| 1210 | 1184|<-Tr |
| 2620 | 2924 | ! |
| 2924 | 2620 |! |
| 5020 | 5564 |& |
| 5564 | 5020 |& |
| 6232 | 6368 |T |
| 6368 | 6232 |T |
| 8128 | 8128 |!!! |

*./ Nhìn bảng trên, ta thấy không thể chấp nhận các kết quả tô màu đỏ;
*./ Hơn nữa, chúng ta có thể giảm thời gian khi loại những đáp án trùng (tô màu tím hay có đánh dấu tại cột 'C'

 

[boyxin]

Cũng chỉ mong bạn & tôi, chúng ta càng ngày càng hoàn thiện hơn mà thôi!

Kết quả trên máy của mình về thời gian: 1.548875
Nhưng vẫn còn những điều chưa hết ý cho lắm; Như sau:

* Kết quả:

| A | B |C |
| 6 | 6 | |
| 28 | 28 | |
| 220 | 284 | |
| 284 | 220 | |
| 496 | 496 | |
| 1184 | 1210 |<-Tr |
| 1210 | 1184|<-Tr |
| 2620 | 2924 | ! |
| 2924 | 2620 |! |
| 5020 | 5564 |& |
| 5564 | 5020 |& |
| 6232 | 6368 |T |
| 6368 | 6232 |T |
| 8128 | 8128 |!!! |

*./ Nhìn bảng trên, ta thấy không thể chấp nhận các kết quả tô màu đỏ;
*./ Hơn nữa, chúng ta có thể giảm thời gian khi loại những đáp án trùng (tô màu tím hay có đánh dấu tại cột 'C'

Hic, cái đáng quan tâm ở đây là xử lý tốc độ, giảm thời gian code làm việc

1. Còn mấy cái liệt kê đó thì có thể thay đổi đơn giản
2. Việc chấp nhận hay không chấp nhận là do quan điểm (có thể làm 1 test: chấp nhận 28 và 28 là 1 cặp số; phản đối khảng định trên)

Theo boyxin thuật toán tính tổng các ước như hoangvuluan đã làm

Function uSum(So As Long) As Long
' Hàm tính tổng các ước '
Dim s As Long, i As Long
    s = 1
    For i = 2 To Int(Sqr(So))
        If (So Mod i = 0) Then s = s + i + IIf(i ^ 2 <> So, So \ i, 0)
    Next
    uSum = s
End Function

đã rút ngắn thời gian đáng kể

Vấn đề đặt ra là liệu có thể thay đổi để rút ngắn thời gian được nữa không? Mong các Bác quan tâm

 

[ChanhTQ@]

Bài số 15 đây:

Đề bài 15:

 ABCDE
-------- = 9           '(Hay là abcde/fghij =9)'
 FGHIJ
 
Tìm các số mà các chữ cái đang làm đại diện cho chúng.

Hãy tìm các đáp án bằng một macro giúp tôi nha; Xin cảm ơn các bạn.

 

[rollover79]

Đề bài 15:

 ABCDE
-------- = 9           '(Hay là abcde/fghij =9)'
 FGHIJ
 
Tìm các số mà các chữ cái đang làm đại diện cho chúng.

Hãy tìm các đáp án bằng một macro giúp tôi nha; Xin cảm ơn các bạn.

Bài này không có kết quả thỏa mãn điều kiện đâu. cả 2 số đều là 4 chữ số và không có các con số trùng nhau trong cả 2 số. Xét cái số ở mẫu số sẽ thấy số nhỏ nhất có thể thỏa mãn điều kiện đầu bài(4 chữ số khác nhau) là số 1234. Đem số này nhân với 9 sẽ có kết quả là 1234x9=11106 là 1 số có 5 chữ số, vậy nếu các số khác lớn hơn thì đương nhiên là cũng là số có 5 chữ số, vậy sao mà thỏa mãn được điều kiện đầu bài.
(Xin lỗi là đọc nhầm thành 4 chữ số, ở đây là 5 chữ số, nhưng kết quả cũng tương tự, không có kết quả thỏa mãn được)

Làm mò ra đáp số:
10638 * 9 = 95742
10647 * 9 = 95823

..........

Ồ, Xin lỗi vì đã suy luận nhầm, thiếu mất số 0.

 

[boyxin]

Làm mò ra đáp số:
10638 * 9 = 95742
10647 * 9 = 95823

..........​

 

[ChanhTQ@]

Làm mò ra đáp số:

10638 * 9 = 95742    ;                      10647 * 9 = 95823

.......

Còn 1 đáp án nữa BoyXin à!
&
Có chung tính chất : Các số ở mẫu số (cũng như các số ở tử số), đều chia hết cho 9

 

[boyxin]

Còn 1 đáp án nữa BoyXin à!

Sub Bai15()
Dim sbc As Long, sc As Long
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte
Dim f As Byte, g As Byte, h As Byte, i As Byte, j As Byte
For sc = 10234 To 11111
    sbc = sc * 9
    f = 1: g = (sc \ 1000) Mod 10: h = (sc \ 100) Mod 10: i = (sc \ 10) Mod 10: j = sc Mod 10
    a = 9: b = (sbc \ 1000) Mod 10: c = (sbc \ 100) Mod 10: d = (sbc \ 10) Mod 10: e = sbc Mod 10
    If (b <> 1) * (b <> 9) * (b <> c) * (b <> d) * (b <> e) * (b <> g) * (b <> h) * (b <> i) * (b <> j) * _
        (c <> 1) * (c <> 9) * (c <> d) * (c <> e) * (c <> g) * (c <> h) * (c <> i) * (c <> j) * _
        (d <> 1) * (d <> 9) * (d <> e) * (d <> g) * (d <> h) * (d <> i) * (d <> j) * _
        (e <> 1) * (e <> 9) * (e <> g) * (e <> h) * (e <> i) * (e <> j) * _
        (g <> 1) * (g <> 9) * (g <> h) * (g <> i) * (g <> j) * _
        (h <> 1) * (h <> 9) * (h <> i) * (h <> j) * _
        (i <> 1) * (i <> 9) * (i <> j) * _
        (j <> 1) * (j <> 9) Then
    [a65535].End(xlUp).Offset(1).Value = sbc
    [b65535].End(xlUp).Offset(1).Value = sc
    End If
Next
End Sub

Kết quả:

1. 10638 * 9 = 95742
2. 10647 * 9 = 95823
3. 10836 * 9 = 97524

---------------------------

Có chung tính chất : Các số ở mẫu số (cũng như các số ở tử số), đều chia hết cho 9

[center] :-= +-+-+-+ -=.,, :=\+ @$@!^%[/center]

Nếu cho biết tính chất mẫu chia hết cho 9 thì thay

For sc = 10234 To 11111

thành

For sc = 10233 To 11111 Step 9

sẽ giảm chút về số vòng lặp, cải thiện thêm chút về thời gian

 

[Lệnh Hồ Đại Hiệp]

Đề bài 15:

 ABCDE
-------- = 9           '(Hay là abcde/fghij =9)'
 FGHIJ
 
Tìm các số mà các chữ cái đang làm đại diện cho chúng.

Hãy tìm các đáp án bằng một macro giúp tôi nha; Xin cảm ơn các bạn.

- Không số nào lặp lại
- ABCDE chia hết cho 9 --> A+B+C+D chia hết cho 9
- Vì Mẫu số > Tử số :

- Nếu F = 0 --> F = . . . .
- Nếu F # 0 : F*9 = A --> F = 1; A = 9
​

Mới nghĩ được đến đấy. Hu hu hu

--CV--