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

Liên hệ QC
Cứ nghĩ đề 6 yêu cầu nhiều, anh em phải có thời gian để làm bài. Nhưng anh em làm ngọt quá ! Và cú pháp càng lúc càng gọn.
Lấy ý từ Sub SoGanhTN của ThuNghi và định dạng của Boyxin viết Sub SoGanh (lần này cố loại các vòng lặp thừa, không biết có thể gọn hơn nữa không?)
Mã: 
Sub SoGanh()
Dim i As Long, n As Long, r As Long, Str3 As String
Application.ScreenUpdating = False
Cells.ClearContents
For i = 0 To 999
  For n = 0 To 9
    If i Mod 10 <> n Then
      r = r + 1
      Str3 = Format(i, "000")
      Cells(r, 1) = Str3 & n & Right(Str3, 1) & Mid(Str3, 3, 1) & Left(Str3, 1)
    End If
  Next
Next
[A1].CurrentRegion.NumberFormat = "000 0 000"
End Sub
 
Nếu tránh việc ghi dữ liệu trực tiếp ra Cell thì có thể cải tiến tốc độ thêm 1 ít.
Mã: 
Sub GPE_Boyxin_dung_array()
Dim i As Long, j As Long, k As Long, s2 As Long, soG As Variant
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    [A1].CurrentRegion.Clear
    [M1] = Timer
soG = [a1:a9000]
t = 0
For i = 0 To 999
    k = i Mod 10
    s2 = k * 100 + ((i \ 10) Mod 10) * 10 + (i \ 100)
    For j = 0 To 9
        If j <> k Then
            t = t + 1
            soG(t, 1) = Format(i, "000") & j & Format(s2, "000")
        End If
    Next
Next
[a1:a9000] = soG
    [A1].CurrentRegion.NumberFormat = "000 0 000"
    [M2] = Timer: [M3] = [M2] - [M1]
    [M4] = [A1].CurrentRegion.SpecialCells(2, 1).Count
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub
 
hoangvuluan đã viết:
Nếu tránh việc ghi dữ liệu trực tiếp ra Cell thì có thể cải tiến tốc độ thêm 1 ít.
Nhấp chuột vào đây để mở rộng...

Tuyệt cú mèo

Đúng là thần tốc
code boyxin 0.328125"
code phamduylong 0.34375"
code hoangvuluan dùng array 0.046875" chỉ bằng 1/7 của 0.328125"

Từ cách dùng array như code bác hoangvuluan đã đưa ra ở trên boyxin sửa (bỏ 1 số phép tính) thì chỉ còn 0.03125"
Mã: 
Sub GPE_Array_New()
Dim i As Long, j As Long, s2 As String, soG As Variant
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    [A1].CurrentRegion.Clear
    [M1] = Timer
    soG = [a1:j900]
For j = 0 To 9
    r = 0
    For i = 0 To 999
        If j <> (i Mod 10) Then
            r = r + 1
            s2 = (i Mod 10) & ((i \ 10) Mod 10) & (i \ 100)
            soG(r, j + 1) = i & j & s2
        End If
Next: Next
    [a1:j900] = soG
    [M2] = Timer: [M3] = [M2] - [M1]
    [A1].CurrentRegion.NumberFormat = "000 0 000"
    [M4] = [A1].CurrentRegion.SpecialCells(2, 1).Count
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub
 
Lần chỉnh sửa cuối:
Đúng là "đừng có lúc nào tự thỏa mãn lâu quá".

Tạm gán biến 6D cho phương án của HoangVuLuan, ta dùng kiểu này soi rọi lại các phương án trước đây (như 1A, 1B, . . . . , 5B) xem sao ta?
Mà cũng nhờ các phương án 6A..6C ta mới có con số 9.000;
Vậy sinh ra câu hỏi: Nếu khi con số đó nó lên đến hàng vạn thì sẽ ra sao đây ta, về tốc độ í mà!?

Rất cảm ơn mọi người đã quan tâm đến Topic! :-=
Mã: 
Bài tập 01: #1-#3;             Bài tập 02" #17
Bài tập 03: #29;                Bài tập 04: #32
Bài tập 05: #53;                Bài tập 06: #57
 
Lần chỉnh sửa cuối:
ChanhTQ@ đã viết:
Tạm gán biến 6D cho phương án của HoangVuLuan, ta dùng kiểu này soi rọi lại các phương án trước đây (như 1A, 1B, . . . . , 5B) xem sao ta?
Mà cũng nhờ các phương án 6A..6C ta mới có con số 9.000;
Vậy sinh ra câu hỏi: Nếu khi con số đó nó lên đến hàng vạn thì sẽ ra sao đây ta, về tốc độ í mà!?

Rất cảm ơn mọi người đã quan tâm đến Topic! :-=
Nhấp chuột vào đây để mở rộng...
Em thấy dùng hàm mà liên quan đến text chạy sẽ chậm hơn, kết hợp Array (HVL) em làm thử code sau.
BoyXin test hộ nhé, máy của mình chạy như rùa.
PHP: 
Option Base 1
Option Explicit
Dim i As Long, j As Long, k As Long, myRng As Range, MaxTT As Long
Dim vStr As Variant
Sub SoGanhTN01()
Application.ScreenUpdating = False
k = 1
[A1:A65000].Clear
[B1] = Timer
MaxTT = 10000 '1000 cap * 10'
vStr = Range(Cells(1, 1), Cells(MaxTT, 1))
For j = 0 To 9
    For i = 0 To 999
        If j <> i Mod 10 Then
            If i < 100 Then
                vStr(k, 1) = i & j & i Mod 10 & Int(i / 10) & 0
                k = k + 1
            Else
                vStr(k, 1) = i & j & i Mod 10 & Int((i Mod 100) / 10) & Int(i / 100)
                k = k + 1
            End If
        End If
    Next
Next
Set myRng = Range(Cells(1, 1), Cells(k - 1, 1))
With myRng
    .Value = vStr
    .NumberFormat = "0000000"
End With
Set myRng = Nothing: Set vStr = Nothing
[B2] = Timer: [B3] = [B2] - [B1]
Application.ScreenUpdating = True
End Sub
 
ThuNghi đã viết:
Em thấy dùng hàm mà liên quan đến text chạy sẽ chậm hơn, kết hợp Array (HVL) em làm thử code sau.
BoyXin test hộ nhé, máy của mình chạy như rùa.
Nhấp chuột vào đây để mở rộng...

code này test trên máy boyxin 0.0625" (cũng bài liệt kê số gánh này, Code cũ của bác ThuNghi: 1,515625")
 
Mà cũng nhờ các phương án 6A..6C ta mới có con số 9.000
Nhấp chuột vào đây để mở rộng...
Chỉ duy nhất bài 3: các ký số không trùng là ta biết trước số lượng các số đẹp bằng công thức tính tổ hợp, còn các bài khác thì không có cách tính nào chính xác, nếu có thì chỉ là phỏng tính. Vậy, phương án Array rất hay, nhưng phải chấp nhận việc sẽ có những giá trị zero trong mảng vì ta phải tạo 1 mảng có kích thước lớn hơn con số ước tính.
 
Trong trường hợp tổng quát thì khó để xác định chính xác kích thước của array. Nhưng riêng đối với bài 6 thì hoàn toàn tính ra được giá trị 9000.
Thứ nhất, mọi số có 3 chữ số từ 000 đến 999 đều tồn tại duy nhất một số là số ngược của nó.
Thứ hai, vì điều kiện chữ số ở giữa phải khác chữ số cuối của số 3 chữ số ở trước, do đó với mỗi chữ số cuối tồn tại 9 chữ số khác với nó.
Từ 2 điều này suy ra có chính xác 9000 chữ số phù hợp yêu cầu.

Trong các trường hợp khác, thường thì dùng biến varian để nhận vùng dữ liệu có thể vượt quá kích thước, sau khi thực hiện các phép tính, có thể Redim một biến mảng và thực hiện lại (các) lệnh gán nếu thấy cần thiết.

Thân!
 
Tổng hợp kết quả 6 bài toán về các con số
Với lời giải của các bác trong topic này. Em có chỉnh sửa tý xíu theo cách dùng Array
(áp dụng vụng về, mong nhận được góp ý thêm)
​

  1. Bài 1: 5.609375" (500 000 số)
  2. Bài 2: 0.28125" (55 252 số)
  3. Bài 3: 0.1875" (55 252 số)
  4. Bài 4: 0.859375" (120 960 số)
  5. Bài 5: 0.015625" (1 144 số)
  6. Bài 6: 0.03125" (9 960 số)
(Thông số về thời gian ở trên là kết quả test trên máy của em )
-------------------------------
Trong VBA: khai báo biến tường minh cũng làm tăng tốc độ sử lý
​
 

File đính kèm

  • KQ 6 btoan.rar
    359.9 KB · Đọc: 61
Lần chỉnh sửa cuối:
Hãy giúp tôi hiểu về đề bài toán này với

Đề bài 07:
Có bao nhiêu số chẵn gồm sáu chữ số khác nhau từng đôi một, trong đó chữ số đầu tiên là chữ số lẽ.

Bạn hãy cho vài ví dụ theo cách hiểu của bạn. Xin cảm ơn các bạn nhiều, nhiều vô kể. . .


Bài tập 08:
Có bao nhiêu số chẵn gồm sáu chữ số, trong đó luôn chứa ba chữ số lẽ & chúng đều lớn hơn 99 999. Bạn giúp tôi liệt kê chúng lên trang tính.
Ví dụ: 111222, . . ., 121416, . . . . 987654, . .

Bổ sung & sửa đổi (Ngày 09/12/08):
Đề bài 07 này tạm thời chưa ai hiểu được, vậy nên đã chuyển sang giải quyết đề bài 07 thay thế tại #85; Mong các bạn gần xa tích cực ủng hộ.
Rất xin cảm ơn!!
 
Lần chỉnh sửa cuối:
Hình như có tổng cộng 42.000 số thỏa mãn yêu cầu:
công thức tính là:
1. có 5 chữ số lẻ 1, 3, 5, 7, 9 đứng đầu mỗi nhóm số
2. có 5 chữ số chẵn 0, 2, 4, 6, 8 đứng cuối mỗi nhóm số
3. ở giữa có 4 số khác nhau với 2 vị trí đầu và cuối => có 8 số, chọn 4 trong 8 (tổ hợp chập 4 của 8: hàm Combin(8, 4) ) để tạo ra 1 hoán vị (4! - hàm Fact(4))
4. Tóm lại, số các số là: 5 * 5 * Fact(4) * Combin(8, 4) = 42.000

Không biết có gì sai sót không?
 
Và xem thử mã sau đã chạy đúng chưa:
Mã: 
Sub bai7()
Const sn = "0123456789"
Dim st As String
Dim ra As Range
Dim va As Variant
vt = 0
Set ra = [A1:A42000]
ra.ClearContents
va = ra
For c1 = 1 To 9 Step 2
    For c6 = 0 To 8 Step 2
        st = Replace(Replace(sn, c1 & "", ""), c6 & "", "")
        For c2 = 1 To 8
            For c3 = c2 + 1 To 8
                For c4 = c3 + 1 To 8
                    For c5 = c4 + 1 To 8
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c3, 1) & Mid(st, c4, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c3, 1) & Mid(st, c5, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c4, 1) & Mid(st, c3, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c4, 1) & Mid(st, c5, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c5, 1) & Mid(st, c4, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c2, 1) & Mid(st, c5, 1) & Mid(st, c3, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c2, 1) & Mid(st, c4, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c2, 1) & Mid(st, c5, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c4, 1) & Mid(st, c2, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c4, 1) & Mid(st, c5, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c5, 1) & Mid(st, c4, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c3, 1) & Mid(st, c5, 1) & Mid(st, c2, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c2, 1) & Mid(st, c3, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c2, 1) & Mid(st, c5, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c3, 1) & Mid(st, c2, 1) & Mid(st, c5, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c3, 1) & Mid(st, c5, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c5, 1) & Mid(st, c2, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c4, 1) & Mid(st, c5, 1) & Mid(st, c3, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c2, 1) & Mid(st, c3, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c2, 1) & Mid(st, c4, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c3, 1) & Mid(st, c2, 1) & Mid(st, c4, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c3, 1) & Mid(st, c4, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c4, 1) & Mid(st, c2, 1) & Mid(st, c3, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    ss = c1 & Mid(st, c5, 1) & Mid(st, c4, 1) & Mid(st, c3, 1) & Mid(st, c2, 1) & c6
                        vt = vt + 1
                        va(vt, 1) = ss
                    Next
                Next
            Next
        Next
    Next
Next
ra = va
End Sub
 
Em lại tính ra 143750 số thỏa mãn điều kiện


Số thỏa mãn yêu cầu: n = n1 - n2 - n3 - n4 - n5 - n6
  • Các số chẵn <=> n6 luôn là số chẵn
  • các số > 99 999 <=> n1 > 0
  1. Lẻ - Lẻ - Lẻ - Chẵn - Chẵn - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  2. Lẻ - Lẻ - Chẵn - Lẻ - Chẵn - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  3. Lẻ - Lẻ - Chẵn - Chẵn - Lẻ - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  4. Lẻ - Chẵn - Lẻ - Lẻ - Chẵn - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  5. Lẻ - Chẵn - Chẵn - Lẻ - Lẻ - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  6. Lẻ - Chẵn - Lẻ - Chẵn - Lẻ - Chẵn = 5 * 5 * 5 * 5 * 5 * 5 = 15625 số
  7. Chẵn - Lẻ- Chẵn - Lẻ - Lẻ - Chẵn = 4 * 5 * 5 * 5 * 5 * 5 = 12500 số
  8. Chẵn - Lẻ- Lẻ - Chẵn - Lẻ - Chẵn = 4 * 5 * 5 * 5 * 5 * 5 = 12500 số
  9. Chẵn - Lẻ- Lẻ - Lẻ - Chẵn - Chẵn = 4 * 5 * 5 * 5 * 5 * 5 = 12500 số
  10. Chẵn - Chẵn - Lẻ- Lẻ - Lẻ - Chẵn = 4 * 5 * 5 * 5 * 5 * 5 = 12500 số
Tổng số = 6 * 15625 + 4 * 12500 = 143750
 
Lần chỉnh sửa cuối:
boyxin đã viết:
Em lại tính ra 153750 số thỏa mãn điều kiện
Nhấp chuột vào đây để mở rộng...
Hình như BoyXin đang tính cho bài 08, phải không?

Bổ sung:

Rất vui vì qua 1 tuần tồn tại, Topic của chúng ta có hơn 70 bài viết & trung bình mỗi ngày có 200 lượt thành viên ghé qua xem xét.

Xin Cảm ơn các bạn, những thành viên đã quan tâm & nhất là viết bài cho Topic này!

Rất trân trọng!
 
Lần chỉnh sửa cuối:
Bài 8

PHP: 
Sub bai8()
Dim Rng As Variant, iR As Long
Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long
[A1:I18750].Clear
Rng = [A1:B18750]
[K1] = Timer
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
For n1 = 1 To 2
    iR = 0
    For n6 = 0 To 8 Step 2
        For n = 0 To 9999
            n2 = (n \ 1000): n3 = (n \ 100) Mod 10: n4 = (n \ 10) Mod 10: n5 = n Mod 10
            If n1 Mod 2 = 1 Then
                If (n2 * n3 Mod 2 = 1) And (n4 Mod 2 = 0) And (n5 Mod 2 = 0) _
                    Or (n2 * n4 Mod 2 = 1) And (n3 Mod 2 = 0) And (n5 Mod 2 = 0) _
                    Or (n2 * n5 Mod 2 = 1) And (n3 Mod 2 = 0) And (n4 Mod 2 = 0) _
                    Or (n3 * n4 Mod 2 = 1) And (n2 Mod 2 = 0) And (n5 Mod 2 = 0) _
                    Or (n3 * n5 Mod 2 = 1) And (n2 Mod 2 = 0) And (n4 Mod 2 = 0) _
                    Or (n4 * n5 Mod 2 = 1) And (n2 Mod 2 = 0) And (n3 Mod 2 = 0) Then
                    iR = iR + 1
                    Rng(iR, n1) = n1 & n2 & n3 & n4 & n5 & n6
                End If
            Else
                If (n2 * n3 * n4 Mod 2 = 1) And (n5 Mod 2 = 0) _
                    Or (n2 * n3 * n5 Mod 2 = 1) And (n4 Mod 2 = 0) _
                    Or (n2 * n4 * n5 Mod 2 = 1) And (n3 Mod 2 = 0) _
                    Or (n3 * n4 * n5 Mod 2 = 1) And (n2 Mod 2 = 0) Then
                    iR = iR + 1
                    Rng(iR, n1) = n1 & n2 & n3 & n4 & n5 & n6
                End If
            End If
Next: Next: Next
[A1:B18750] = Rng
[C1:I18750].FormulaR1C1 = "=RC[-2]+200000"
[C1:I18750] = [C1:I18750].Value
[D12501:D18750].Clear: [F12501:F18750].Clear: [H12501:H18750].Clear
[K2] = Timer: [K3] = [K2] - [K1]
[K4] = [A1:I18750].SpecialCells(2, 1).Count
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub
Liệt kê được 143 750 số
--------------------------------
Sửa code theo góp ý của Bác Ptm0412 bài #80 : 0.765625"

 
Lần chỉnh sửa cuối:
= 4 * 5 * 5 * 5 * 5 * 5 = 15000 số
Nhấp chuột vào đây để mở rộng...

4 * 5 * 5 * 5 * 5 * 5 = 4 * 5^5 = 12.500
15.625 * 6 + 12.500 * 4 = 143.750

Boy xin xem chỗ này: số 5 đỏ lẽ ra là 3
Mã: 
If s > 2 And s Mod 2 = 1 Then
   If (n1 * n2 * n3 Mod 2 = 1) Or (n1 * n2 * n4 Mod 2 = 1) Or (n1 * n2 * n5 Mod 2 = 1) _
     Or (n2 * n3 * n4 Mod 2 = 1) Or (n2 * n3 * n5 Mod 2 = 1) Or _
        (n[B][COLOR="Red"]5[/COLOR][/B] * n4 * n5 Mod 2 = 1) Then

Thuật toán của cả Hvl và boyxin vẫn chưa đúng ở chỗ: If s > 2 And s Mod 2 = 1: Liệt kê luôn mấy em có 1 số lẻ và số có 5 số lẻ, vì các số này cũng thoả đk s Mod 2 = 1

ngoài ra: n1 + n2 + n3 Mod 2 <> (n1 + n2 + n3) Mod 2
và: n4 + n5 Mod 2 <> (n4 + n5) Mod 2

Còn nữa: Code của Hvl: And ((n4 + n5) Mod 2 = 0)) không bảo đảm cả n4 và n5 đều chẵn. Muốn bảo đảm cả n4 và n5 đều chẵn thì chỉ có thể And (n4 Mod 2 = 0 And n5 Mod 2 = 0)
 
Lần chỉnh sửa cuối:
Code của Boyxin giữ nguyên, nhưng chỉ cần cho kết quả 2 cột A và B, các cột còn lại thì dùng lệnh

Range(...).FormulaR1C1 = "=RC[-2]+200000"
Range(...)=Range(...).Value

giảm còn 1/3 thời gian, chỉ cần chú ý cột cao cột thấp.
 
Một cách củ chuối nhưng bù lại được cái tốc độ ​
PHP: 
Sub Bia8_new()
Dim Rng As Variant, iR As Long
Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long
[A1:J15625].Clear
Rng = [A1:J15625]
[m1] = Timer
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
'1) L L L C C C
For n1 = 1 To 9 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 0 To 8 Step 2
                For n5 = 0 To 8 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 1) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'2) L L C L C C
For n1 = 1 To 9 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 0 To 8 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 0 To 8 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 2) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'3) L L C C L C
For n1 = 1 To 9 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 0 To 8 Step 2
            For n4 = 0 To 8 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 3) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'4) L C L L C C
For n1 = 1 To 9 Step 2
    For n2 = 0 To 9 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 0 To 8 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 4) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'5) L C C L L C
For n1 = 1 To 9 Step 2
    For n2 = 0 To 8 Step 2
        For n3 = 0 To 8 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 5) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'6) L C L C L C
For n1 = 1 To 9 Step 2
    For n2 = 0 To 8 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 0 To 8 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 6) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'7) C L C L L C
For n1 = 2 To 8 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 0 To 8 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 7) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'8) C L L C L C
For n1 = 2 To 8 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 0 To 8 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 8) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'9) C L L L C C
For n1 = 2 To 8 Step 2
    For n2 = 1 To 9 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 0 To 8 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 9) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next: iR = 0
'10)C C L L L C
For n1 = 2 To 8 Step 2
    For n2 = 0 To 8 Step 2
        For n3 = 1 To 9 Step 2
            For n4 = 1 To 9 Step 2
                For n5 = 1 To 9 Step 2
                    For n6 = 0 To 8 Step 2
                        iR = iR + 1
                        Rng(iR, 10) = n1 & n2 & n3 & n4 & n5 & n6
Next: Next: Next: Next: Next: Next
[A1:J15625] = Rng
[m2] = Timer: [m3] = [m2] - [m1]
[m4] = [A1:J15625].SpecialCells(2, 1).Count
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub
 
Tương tự bài trên, chỉ làm 3.125 dòng, sau đó:

Range("A3126:F15625").FormulaR1C1 = "=R[-3125]C+200000"
Range("G3126:J12500").FormulaR1C1 = "=R[-3125]C+200000"
Range("A3126:j15625") = Range("A3126:j15625").Value

Giảm còn 1/2 thời gian
 
Lần chỉnh sửa cuối:
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

NCSCVN
Vì sao Vẹt không biết "hót" nhưng cực thích bắt chước tiếng người? Làm sao thuần hóa và chăm sóc chúng?
Trả lời
2
Đọc
17
NCSCVN
NCSCVN
Bạn Đoàn
Em muốn làm bảng phân tích nhanh hơn từ BOM bên khách hàng cho, Mong anh chị giúp đỡ ạ
    • Cười
Trả lời
8
Đọc
251
Bạn Đoàn
Bạn Đoàn
C
  • Question
Nhờ các bác giúp đỡ tạo bảng hẹn bệnh nhân
Trả lời
0
Đọc
1
creed_19061994
C
A
  • Question
Nhờ viết code paste values cho tất cả các sheet
2
Trả lời
28
Đọc
5K
viethung78
V
A
Excel bị xóa mất file để chạy VBA
Trả lời
0
Đọc
12
akjrathanh
A
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom