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

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
(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
 
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!

Mã: 
 [/COLOR]
[COLOR=white] Randomize
 Tong = 999999 - Int(8 * Rnd * 10 ^ 5)
[/COLOR]
[COLOR=white]
--=0
 
Lần chỉnh sửa cuối:
Dùng hàm:
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é!
 
Thật là một tuyệt chiêu lần đầu tiên được thấy về biến mảng.

Mã: 
     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!
 
Lần chỉnh sửa cuối:
Sắp thứ tự

Chào bạn!
Cái này:
SA_DQ đã viết:
Mã: 
     a(k) = a(k) + 1
Nhấp chuột vào đây để mở rộng...
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:
SA_DQ đã viết:
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
Nhấp chuột vào đây để mở rộng...

Thân!
Rất cảm ơn các bạn quan tâm![/quote]
 
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!
 
Số nhỏ nhất

SA_DQ đã viế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!
Nhấp chuột vào đây để mở rộng...
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:

Mã: 
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
 
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!

boyxin đã viết:
  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ỉ?
Nhấp chuột vào đây để mở rộng...
Không tính mà! Nếu tính thì chắc chúng không thương nhau rồi!
 
Lần chỉnh sửa cuối:
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

PHP: 
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 |
|. . . .|. . . .|
 
SA_DQ đã viết:
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

PHP: 
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
Nhấp chuột vào đây để mở rộng...
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"
PHP: 
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?
 
Chỉnh sửa lần cuối bởi điều hành viên:
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;
 
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:
Mã: 
' 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
 
boyxin đã viết:
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?
Nhấp chuột vào đây để mở rộ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'
 
Lần chỉnh sửa cuối:
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!

ChanhTQ@ đã viết:
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'
Nhấp chuột vào đây để mở rộng...

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
PHP: 
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
 
Bài số 15 đây:

Đề bài 15:
PHP: 
 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.
 
ChanhTQ@ đã viết:
Đề bài 15:
PHP: 
 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.
Nhấp chuột vào đây để mở rộng...
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)

boyxin đã viết:
Làm mò ra đáp số:
10638 * 9 = 95742
10647 * 9 = 95823

..........
Nhấp chuột vào đây để mở rộng...
Ồ, Xin lỗi vì đã suy luận nhầm, thiếu mất số 0.
 
Chỉnh sửa lần cuối bởi điều hành viên:

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

..........​
 
Chỉnh sửa lần cuối bởi điều hành viên:
Chỉnh sửa lần cuối bởi điều hành viên:
ChanhTQ@ đã viết:
Còn 1 đáp án nữa BoyXin à!
Nhấp chuột vào đây để mở rộng...
Mã: 
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
---------------------------
ChanhTQ@ đã viết:
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
PHP: 
[center] :-= +-+-+-+ -=.,, :=\+ @$@!^%[/center]
Nhấp chuột vào đây để mở rộng...
Nếu cho biết tính chất mẫu chia hết cho 9 thì thay
PHP: 
For sc = 10234 To 11111
thành
PHP: 
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ần chỉnh sửa cuối:
ChanhTQ@ đã viết:
Đề bài 15:
PHP: 
 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.
Nhấp chuột vào đây để mở rộng...

- 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--
 
Xin góp vui 1 code
Mã: 
Sub Bai15()
    Dim i As Long, j As Long, k As Long, iRow As Long
    iRow = 1
    j = WorksheetFunction.Ceiling(10234, 9)
    For i = j To 11111 Step 9
        k = 9 * i
        If IsValid(i, k) Then
            Cells(iRow, 1) = i
            Cells(iRow, 2) = k
            iRow = iRow + 1
        End If
    Next
End Sub

Function IsValid(ByVal Num1 As Long, ByVal Num2 As Long)
    Dim i As Integer, j As Integer, str As String
    Dim ret As Boolean
    ret = True
    str = Num1 & Num2
    For i = 1 To Len(str) - 1
        For j = i + 1 To Len(str)
            If Mid(str, i, 1) = Mid(str, j, 1) Then
                ret = False
                Exit For
            End If
        Next
        If Not ret Then Exit For
    Next
    IsValid = ret
End Function
 
rollover79 có giải thuật thật tuyệt vời!

Nhưng macro
PHP: 
Sub Bai15()
    Dim i As Long, j As Long, k As Long, iRow As Long
    iRow = 1
    j = WorksheetFunction.Ceiling(10234, 9)
    For i = j To 11111 Step 9
        k = 9 * i
        If IsValid(i, k) Then
            Cells(iRow, 1) = i
            Cells(iRow, 2) = k
            iRow = iRow + 1
        End If
    Next
End Sub
chưa được chứng mình, mà chỉ quan sát thất vậy thôi
Có nghĩa là:
Nếu ta có số 5 chữ số đơn không lặp lại chia hết cho 9 & tạo ra đáp án cũng là 5 chữ số đơn còn lại thì đáp số này cũng chia hết cho 9 - Điều này cần phải được chứng minh, thì bài macro mới tồn tại có bản quyền!

Minh họa, ta phải chứng minh: Nếu ABCDE chia FGHIJ = 9 thì FGHIJ chia hết cho 9

Hay ta chuyển bài này thành bài 15B đi vậy!​
 
ChanhTQ@ đã viết:
Nhưng macro
PHP: 
Sub Bai15()
    Dim i As Long, j As Long, k As Long, iRow As Long
    iRow = 1
    j = WorksheetFunction.Ceiling(10234, 9)
    For i = j To 11111 Step 9
        k = 9 * i
        If IsValid(i, k) Then
            Cells(iRow, 1) = i
            Cells(iRow, 2) = k
            iRow = iRow + 1
        End If
    Next
End Sub
chưa được chứng mình, mà chỉ quan sát thất vậy thôi
Có nghĩa là:
Nếu ta có số 5 chữ số đơn không lặp lại chia hết cho 9 & tạo ra đáp án cũng là 5 chữ số đơn còn lại thì đáp số này cũng chia hết cho 9 - Điều này cần phải được chứng minh, thì bài macro mới tồn tại có bản quyền!

Minh họa, ta phải chứng minh: Nếu ABCDE chia FGHIJ = 9 thì FGHIJ chia hết cho 9


Hay ta chuyển bài này thành bài 15B đi vậy!​
Nhấp chuột vào đây để mở rộng...

Điều này được suy ra từ các mệnh đề sau:
1. tổng các số từ 1..9 = 45 = 9 x 5
2. số chía hết cho 9 <=> tổng các chữ số chia hết cho 9
3. ABCDE VÀ FGHIJ đươc tạo thành từ 0..9
4. ABCDE chia hết cho 9 suy ra tổng các chữ số còn lại (FGHIJ) là hiệu của 45 với tổng các chữ số ABCDE cũng là một bội của 9
5. kết luận FGHIJ chia hết cho 9.
 
Xin cải biên của Rollover79 xíu, không rõ nhanh hơn không chừng?!

PHP: 
Sub Bai_15()
' ABCDE/FGHIJ = 9 => A=9; F=1; G=0'
 Dim Hh As Long, iI As Long, Jj As Long, Tong As Long
 
 Range("A1:b" & [a65500].End(xlUp).Row).Clear
 For Hh = 2 To 8
    For iI = 2 To 8
        For Jj = 2 To 8
            If Hh <> iI And Hh <> Jj And iI <> Jj Then
                Tong = 9 * (10000 + Hh * 100 + iI * 10 + Jj)
                If Tong > 98765 Then
                    Exit Sub
                ElseIf Tong / 9 Mod 9 = 0 Then
                    If Not KiemTrung(Tong) Then
                        [a65500].End(xlUp).Offset(1) = Tong
                        [a65500].End(xlUp).Offset(, 1) = "10" & Hh & iI & Jj
                    End If
                End If
            End If
        Next Jj
    Next iI
 Next Hh
End Sub

Mã: 
[B]Function KiemTrung(Num1 As Long) As Boolean[/B]
 Dim Str1 As String, Str2 As String:            Dim Jj As Byte
 Str1 = CStr(Num1):                             Str2 = CStr(Num1 / 9)
 
 For Jj = 1 To 5
    If InStr(1, Str1, Mid$(Str2, Jj, 1)) > 0 Then
        KiemTrung = Not KiemTrung:              Exit Function
    End If
 Next Jj
[B]End Function[/B]
 
ChanhTQ@ đã viết:
PHP: 
Sub Bai_15()
' ABCDE/FGHIJ = 9 => A=9; F=1; G=0'
 Dim Hh As Long, iI As Long, Jj As Long, Tong As Long
 
 Range("A1:b" & [a65500].End(xlUp).Row).Clear
 For Hh = 2 To 8
    For iI = 2 To 8
        For Jj = 2 To 8
            If Hh <> iI And Hh <> Jj And iI <> Jj Then
                Tong = 9 * (10000 + Hh * 100 + iI * 10 + Jj)
                If Tong > 98765 Then
                    Exit Sub
                ElseIf Tong / 9 Mod 9 = 0 Then
                    If Not KiemTrung(Tong) Then
                        [a65500].End(xlUp).Offset(1) = Tong
                        [a65500].End(xlUp).Offset(, 1) = "10" & Hh & iI & Jj
                    End If
                End If
            End If
        Next Jj
    Next iI
 Next Hh
End Sub
Mã: 
[B]Function KiemTrung(Num1 As Long) As Boolean[/B]
 Dim Str1 As String, Str2 As String:            Dim Jj As Byte
 Str1 = CStr(Num1):                             Str2 = CStr(Num1 / 9)
 
 For Jj = 1 To 5
    If InStr(1, Str1, Mid$(Str2, Jj, 1)) > 0 Then
        KiemTrung = Not KiemTrung:              Exit Function
    End If
 Next Jj
[B]End Function[/B]
Nhấp chuột vào đây để mở rộng...
Cũng có thể là cách này nhanh hơn chút xíu, nhưng cho em hỏi là tại sao 3 vòng lặp của bác lại chỉ lặp đến 8 thôi nhỉ? Lặp từ 2 thì em hiểu là bác chừa ra 2 số 0 và số 1 ban đầu. Nhưng chừa nốt số 9 thì em chưa hiểu lắm. Bác có thể giải thích 1 chút được không?
 
Cũng có thể là cách này nhanh hơn chút xíu, nhưng cho em hỏi là tại sao 3 vòng lặp của bác lại chỉ lặp đến 8 thôi nhỉ? Lặp từ 2 thì em hiểu là bác chừa ra 2 số 0 và số 1 ban đầu. Nhưng chừa nốt số 9 thì em chưa hiểu lắm. Bác có thể giải thích 1 chút được không?
Nhấp chuột vào đây để mở rộng...
Vì ba số còn lại là của A, F & G tương ứng là 9,1 & 0 mà!
Nói cách khác, chỉ 1 số nào đó > 9 vạn mới chia cho 1 vạn = 9 mà thôi!

Chúc vui!! :-= --=0 )(&&@@ &&&%$R

Bài này khó hơn nè các bạn:

Bài 16: ABCDE / FGHI = 9 (Biết rằng, các chữ cái biểu thị các số > 0)
hay là:
ABCDE
-------- = 9
FGHI
 
HYen17 đã viết:
Vì ba số còn lại là của A, F & G tương ứng là 9,1 & 0 mà!
Nói cách khác, chỉ 1 số nào đó > 9 vạn mới chia cho 1 vạn = 9 mà thôi!

Chúc vui!! :-= --=0 )(&&@@ &&&%$R
Nhấp chuột vào đây để mở rộng...
Em vẫn chưa hiểu lắm, với 2 số đầu là 1 và 0, nếu bác Chanh chỉ cho chạy 3 chữ số tiếp theo đến 8 thì số to nhất chỉ là 10876, con xa mới đến số 11111, vậy làm sao bác khẳng định trong khoảng từ 10877 đến 11111 không có số nào chia hết cho 9?
Bài của bác HYen17 em xin sửa lại code của bài trước 1 chút xíu thế này.(Hàm IsValid giữ nguyên)
Mã: 
Sub Bai16()
    Dim i As Long, j As Long, k As Long, iRow As Long
    iRow = 1
    j = WorksheetFunction.Ceiling(10000, 9)
    For i = j To 99999 Step 9
        k = i / 9
        If Len(k & "") > 4 Then Exit Sub
        If k Mod 9 = 0 Then
            If IsValid(i, k) Then
                Cells(iRow, 1) = i
                Cells(iRow, 2) = k
                iRow = iRow + 1
            End If
        End If
    Next
End Sub

Function IsValid(ByVal Num1 As Long, ByVal Num2 As Long)
    Dim i As Integer, j As Integer, str As String
    str = Num1 & Num2
    For i = 1 To Len(str) - 1
        For j = i + 1 To Len(str)
            If Mid(str, i, 1) = Mid(str, j, 1) Then
                IsValid = False
                Exit Function
            End If
        Next
    Next
    IsValid = True
End Function
 
Lần chỉnh sửa cuối:
Em vẫn chưa hiểu lắm, với 2 số đầu là 1 và 0, nếu bác Chanh chỉ cho chạy 3 chữ số tiếp theo đến 8 thì số to nhất chỉ là 10876, con xa mới đến số 11111, vậy làm sao bác khẳng định trong khoảng từ 10877 đến 11111 không có số nào chia hết cho 9?
Nhấp chuột vào đây để mở rộng...

Tuy xa như vậy, nhưng rất gần, vì rằng (từ thực nghiệm đem lại) như sau:
| A | B | C |
|10876|97884| (Bi = 9 * Ai)|
|10877| <- không thể| 2 số 7|
|10878| <- không thể| 2 số 8|
|10879| <- không thể| số 9 của 'A'|
|>=10880| <- không thể| (trùng với 8 hay 9 như trên)|
|| |Do xem xét tại thực địa |
 
ChanhTQ@ đã viết:
Tuy xa như vậy, nhưng rất gần, vì rằng (từ thực nghiệm đem lại) như sau:
| A | B | C |
|10876|97884| (Bi = 9 * Ai)|
|10877| <- không thể| 2 số 7|
|10878| <- không thể| 2 số 8|
|10879| <- không thể| số 9 của 'A'|
|>=10880| <- không thể| (trùng với 8 hay 9 như trên)|
|| |Do xem xét tại thực địa |
Nhấp chuột vào đây để mở rộng...
Cách này có vẻ chưa thuyết phục lắm
1. Trường hợp 10879 tại sao lại không thể?
2. Nếu cứ cho là cách này đúng thì bác mới chứng minh được số 9 không thể nằm ở cuối, vậy bác chứng minh nốt là số 9 không nằm ở vị trí thứ 3 và thứ 4 nốt xem sao?

From Sa_DQ:
Trong chuỗi ABCDE tại vị trí 'A' chỉ có thể là số '9' (& không khác được). Đã vậy số '9' này phải là số không được xài lần hai, ba . . .

Rollover79: Cảm ơn Sa, có lẽ đây là lời giải thích có lý nhất.
 
Lần chỉnh sửa cuối:
Các dòng lệnh chỉnh sửa đã được định số

Bài của bác HYen17 em xin sửa lại code của bài trước 1 chút xíu thế này.(Hàm IsValid giữ nguyên)
Mã: 
Sub Bai16()
    Dim i As Long, j As Long, k As Long, iRow As Long
    iRow = 1
    j = WorksheetFunction.Ceiling(10000, 9)
    For i = j To [COLOR=red]99999[/COLOR] Step 9
        k = i / 9
        If Len(k & "") > 4 Then Exit Sub
        If k Mod 9 = 0 Then
            If IsValid(i, k) Then
                Cells(iRow, 1) = i
                Cells(iRow, 2) = k
                iRow = iRow + 1
            End If
        End If
    Next
End Sub 
Function IsValid(ByVal Num1 As Long, ByVal Num2 As Long)
    Dim i As Integer, j As Integer, str As String
    str = Num1 & Num2
    For i = 1 To Len(str) - 1 
        For j = i + 1 To Len(str) [COLOR=#ff0000]'<=|[/COLOR]
            If Mid(str, i, 1) = Mid(str, j, 1) Then
                IsValid = False
                Exit Function
            End If
        Next
    Next
    IsValid = True
End Function
Nhấp chuột vào đây để mở rộng...
Trong nổ lực giảm thời gian chạy tàu, mình xin cải biên macro & hàm của tác giả Rollover79 như sau:
PHP: 
Option Explicit
Sub Bai16()
    Dim Ww As Long, Jj As Long, Zz As Long, iRow As Long
    iRow = 2:           [L1] = "Bài 16"
    Jj = WorksheetFunction.Ceiling(10000, 9) '=>10008'
     '10008 * 9 = 90072'
4    For Ww = Jj To Jj * 9 Step 9
        Zz = Ww / 9
6 '        If Len(Zz & "") > 4 Then Exit Sub ' 
        If Zz Mod 9 = 0 Then
            If IsValid(Ww, Zz) Then
                Cells(iRow, 11) = Ww
                Cells(iRow, 12) = Zz:                       iRow = iRow + 1
            End If
        End If
    Next
End Sub
PHP: 
Function IsValid(ByVal Num1 As Long, ByVal Num2 As Long) As Boolean
 Dim Zz As Integer, Ww As Integer
 Dim sTemp As String, Str As String
 Str = Num1 & Num2:             Ww = Len(Str)
 For Zz = 1 To Ww
7    sTemp = IIf(Zz = 1, Mid$(Str, 2), Left$(Str, Zz - 1) & Mid$(Str, Zz + 1))
8    If InStr(sTemp, Mid(Str, Zz, 1)) > 0 Then Exit Function
 Next Zz
 IsValid = True
End Function
Đảm bảo sẽ nhanh hơn ít nhiều!
 
Lần chỉnh sửa cuối:
Bài 17 đây các bạn; Chúng ta vui xuân đi, nhễ!

Thấy ở đây (. . .) có bài hay hay, mời các bạn, chúng ta cùng bắt tay thử sức:

Một số có 6 chữ số được gọi là số Vương/Vua (?) nếu thoả các điều kiện sau:

(*) Không chứa số 0;
(*) Là số chính fương;
(*) Ba cặp đầu, giữa & cuối đều là số chính fương.

http://vn.answers.yahoo.com/questio...EC95XPBMnX1G;_ylv=3?qid=20110208161757AAEwTRWChúc xuân vui vẻ đến mọi nhà!
 
Lần chỉnh sửa cuối:
ChanhTQ@ đã viết:
Thấy ở đây có bài hay hay, mời các bạn, chúng ta cùng bắt tay thử sức:

Một số có 6 chữ số được gọi là số Vương/Vua (?) nếu thoả các điều kiện sau:

(*) Không chứa số 0;
(*) Là số chính fương;
(*) Ba cặp đầu, giữa & cuối đều là số chính fương.

http://vn.answers.yahoo.com/questio...EC95XPBMnX1G;_ylv=3?qid=20110208161757AAEwTRW

Chúc xuân vui vẻ đến mọi nhà!
Nhấp chuột vào đây để mở rộng...
Chắc là vầy:
PHP: 
Sub Test()
  Dim i As Long, n As Long, tmp As Long
  For i = 317 To 999
    tmp = i ^ 2
    If InStr(tmp, 0) = 0 Then
      If Sqr(Right(tmp, 2)) = Int(Sqr(Right(tmp, 2))) Then
        If Sqr(Left(tmp, 2)) = Int(Sqr(Left(tmp, 2))) Then
          If Sqr(Mid(tmp, 3, 2)) = Int(Sqr(Mid(tmp, 3, 2))) Then
            n = n + 1
            Cells(n, 1) = tmp
          End If
        End If
      End If
    End If
  Next
End Sub
Kết quả = 166464 và 646416
 
Cũng đã lâu rồi bị chìm, nay có cơ lôi lên cho xôm tụ xíu

Bài 18 đây các bạn

Hãy giúp tôi liệt kê lên trang tính các số điện thoại gồm 7 ký số sao thỏa hết các điều kiẹn sau:

(*) Trong một số cụ thể nào đó có chứa hơn 2 con số 1 hay hơn 2 con số 9 ở vị trí bất kỳ trong chuỗi;
Ví dụ 1101901, hay 9912349, 1091199,. . . .
(*) Hai số đầu hay 2 số cuối giống nhau (bổ sung như 1001188, 8801191. . . . )

(+) (hỉ kề từ số 1000011 trở lên đến 9999999 mà thôi



http://www.giaiphapexcel.com/forum/...ên-không-trùng&p=352910&highlight=#post352910
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp! (2 người xem)
Trả lời
0
Đọc
16
truc l
T
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable (1 người xem)
Trả lời
0
Đọc
21
thuhacoicoi
T
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (1 người xem)
    • Thích
Trả lời
4
Đọc
874
nguyendang95
N
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (1 người xem)
    • Cười
Trả lời
9
Đọc
196
SA_DQ
SA_DQ
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel (2 người xem)
Trả lời
2
Đọc
53
Gà Công Nghệ
Gà Công Nghệ
V
Quản lý xuất nhập vật tư trong kho
Trả lời
19
Đọc
741
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
4
Đọc
329
phuongnam366377
phuongnam366377
F
Mấy cao thủ giúp dùm mình với. File excel bị lỗi mà mình không biết lỗi chỗ nào để sửa.
Trả lời
2
Đọc
91
firstbood
F
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
438
Đọc
58K
sát thủ uyên ương
S
X
Làm thế nào để ẩn "Blank" trong Pivot table (1 người xem)
    • Thích
Trả lời
15
Đọc
36K
nguyenngochieu761321
nguyenngochieu761321
H
Đánh số thự theo lượt
Trả lời
5
Đọc
138
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (2 người xem)
Trả lời
2
Đọc
191
danhpheo
D
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show
Trả lời
2
Đọc
139
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
5
Đọc
207
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word (1 người xem)
Trả lời
1
Đọc
156
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
340
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
203
eagle12
E
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
451
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
10K
Hoale85
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom