Liệt kê toàn bộ các số điện thoại đẹp lên trang tính. (4 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)
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.
Web KT

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

N
Khắc phục lỗi "The picture is too large and will be truncated" (2 người xem)
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (4 người xem)
Trả lời
4
Đọc
132
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (1 người xem)
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
273
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
148
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
545
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt (12 người xem)
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy) (3 người xem)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
139
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
123
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
798
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
228
Hoàng Tuấn 868
H
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
    • Thích
Trả lời
0
Đọc
148
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
138
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
224
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
712
thuytrangbp28
T
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
243
Hoàng Tuấn 868
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom