Liệt kê toàn bộ các số điện thoại đẹp lên trang tính.

Liên hệ QC
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!
 
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!

Đ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]
 
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]
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?
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
 
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
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?

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 |
 
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 |
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
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:
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à!
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ả = 166464646416
 
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
 
Web KT
Back
Top Bottom