Code VBA ghép nối và thống kê giữa 2 sheet (1 người xem)

1986QV · 22/12/12

A/E forum GPE viết dùm code VBA cho file sau. File có 2 sheet, sheet 1 có chứa bảng số liệu, sheet 2 là kết quả thỏa mãn những điều kiện sau:
1) Ghép 2 ký tự trong tất cả các ký tự có mặt trên bảng sheet 1.
2) Đánh dấu sự xuất hiện của số bất kỳ nào thuộc 2 ký tự đã ghép từ ở bảng trong sheet 1 theo dk sau:
A,B là 2 ký tự bất kỳ trong 8 ký tự thuộc sheet 1.
- A có 1,B có 1. A giao B =>>"1"
- A có 1, B có " ". A giao B =>>"1"
- A có " ", B có 1. A giao B =>>"1"
- A có " ", B có " ". A giao B =>> " "
Bài toán có phức tạp chút nếu có thắc mắc hay góp ý xin cứ cho kiến cho mình giải thích và đưa ra hướng giải quyết tốt nhất.
Chân thành cảm ơn a/e forum GPE!

huuthang_bd · 22/12/12

1986QV đã viết:
A/E forum GPE viết dùm code VBA cho file sau. File có 2 sheet, sheet 1 có chứa bảng số liệu, sheet 2 là kết quả thỏa mãn những điều kiện sau:
1) Ghép 2 ký tự trong tất cả các ký tự có mặt trên bảng sheet 1.
2) Đánh dấu sự xuất hiện của số bất kỳ nào thuộc 2 ký tự đã ghép từ ở bảng trong sheet 1 theo dk sau:
A,B là 2 ký tự bất kỳ trong 8 ký tự thuộc sheet 1.
- A có 1,B có 1. A giao B =>>"1"
- A có 1, B có " ". A giao B =>>"1"
- A có " ", B có 1. A giao B =>>"1"
- A có " ", B có " ". A giao B =>> " "
Bài toán có phức tạp chút nếu có thắc mắc hay góp ý xin cứ cho kiến cho mình giải thích và đưa ra hướng giải quyết tốt nhất.
Chân thành cảm ơn a/e forum GPE!

Ở sheet 1, cột số liệu số 5 có dữ liệu ở dòng A và B nhưng kết quả của bạn cột số 5 không có gì cả, không biết là bạn nhầm hay có quy tắc khác?

1986QV · 22/12/12

có sự nhầm lẫn bạn ah up lại file rồi bạn

ndu96081631 · 22/12/12

1986QV đã viết:
có sự nhầm lẫn bạn ah up lại file rồi bạn

Code cho bài này chỉ là chuyện nhỏ
Thử làm công thức coi sao nha
Tại sheet 2, gõ vào C4 công thức:

Mã:

=IF(VLOOKUP($A4,Sheet1!$A$4:$M$11,C$3+1,0)+VLOOKUP($B4,Sheet1!$A$4:$M$11,C$3+1,0),1,"")

Kéo fill sang phải và xuống dưới

huuthang_bd · 22/12/12

1986QV đã viết:
có sự nhầm lẫn bạn ah up lại file rồi bạn

Xem trong file nhé bạn.

1986QV · 22/12/12

ndu96081631 đã viết:
Code cho bài này chỉ là chuyện nhỏ
Thử làm công thức coi sao nha
Tại sheet 2, gõ vào C4 công thức:

Mã:

=IF(VLOOKUP($A4,Sheet1!$A$4:$M$11,C$3+1,0)+VLOOKUP($B4,Sheet1!$A$4:$M$11,C$3+1,0),1,"")

Kéo fill sang phải và xuống dưới

Bác ndu96081631 ah. vậy chưa thỏa mãn điều kiện ghép. chỉ lọc và lấy dữ liệu sao đc bác

Ba Tê · 22/12/12

1986QV đã viết:
Bác ndu96081631 ah. vậy chưa thỏa mãn điều kiện ghép. chỉ lọc và lấy dữ liệu sao đc bác

Hông hiểu bạn đã thử công thức của ndu... chưa mà nói vậy.
Bảng kết quả mẫu của bạn còn chưa chính xác nữa là:
Dòng 20, 21 thiếu kết quả cột 12
Dòng 26 lại có E-E???

1986QV · 22/12/12

em dính chính lại bài toán cùng file luôn. có vẻ phức tạp quá, em cố ngẫm rồi nhưng chưa hiểu hết a/e forum có cao kiến cứ cho ý kiến.
Cảm ơn!

1986QV · 22/12/12

Ba Tê đã viết:
Hông hiểu bạn đã thử công thức của ndu... chưa mà nói vậy.
Bảng kết quả mẫu của bạn còn chưa chính xác nữa là:
Dòng 20, 21 thiếu kết quả cột 12
Dòng 26 lại có E-E???

em kiểm tra rồi sai ở khâu ghép ký tự bác ah! giả sử em có 15 hoặc 20 ký tự
ghép 2 trong 20 ký tự rồi báo kết quả.
Của bác nu96081631 chỉ báo trong khi chưa ghép thì làm sao được bác Bate ơi.
bài toán 2 phần thuận và nghịch các bác xem có cao kiến cho em ý kiến với.
Cảm ơn bác và forum giúp đỡ!

ndu96081631 · 23/12/12

1986QV đã viết:
em dính chính lại bài toán cùng file luôn. có vẻ phức tạp quá, em cố ngẫm rồi nhưng chưa hiểu hết a/e forum có cao kiến cứ cho ý kiến.
Cảm ơn!

Tôi cho công thức của tôi vào file mới của bạn, kết quả vẫn chính xác ---> Có chăng là thay đổi tham chiếu 1 chút (vì file mới khác file cũ)

Mã:

=IF(VLOOKUP($A8,Sheet1!$A$4:$M$11,C$7+1,0)+VLOOKUP($B8,Sheet1!$A$4:$M$11,C$7+1,0),1,"")

Công thức gõ tại C8

1986QV · 23/12/12

em lại giả sử lại 1 điều khi các ký tự chưa được sắp xếp như sheet2 thì làm sao paste vào c8 được bác. ví dụ A,B là 2 ký tự được lấy theo thứ tự của 8 ký tự trên.
Các điều kiện chỉ yêu cầu 1 chiều từ A=>>B (A trùng B ở điểm đi được phép đánh dấu) là bài toán sheet 2 được giải quyết. Bài toán ngược lại từ B=>>A tại sheet 3 phải được giải quyết. Và cả sheet 2,3 sử dụng vùng (mảng )lớn không giới hạn. Mong A/E forum đưa ra ý kiến
Cảm ơn A/E quan tâm và giúp đỡ!

1986QV · 27/12/12

Bài toán cũng yêu cầu như vậy nhưng điều kiện thay đổi cho trường hợp đặc biệt này bác xem giúp và viết code giúp em: Cho bảng tính như sheet 1, nhiệm vụ code sheet 2 xử lý như sau:
1) Dựa vào bảng tính sheet 1 sắp xếp các cặp ký tự theo thứ tự các ký tự có trong bảng sheet 1
2) các trường hợp được tính theo điều kiện sau: A giao B,C,D,E,F,...
có xuất hiện: "1" giao "0" cho ra "0"
có xuất hiện: "1" giao " " cho ra "1"
có xuất hiện: " " giao "0" cho ra "0"
có xuất hiện: " " giao " " cho ra " "

Có vẻ như rất phức tạp vơi mình, Nhưng với sự giúp đỡ tận tâm a/e forum GPE chắc không vấn đề gì.hjj
Cảm ơn a/e forum GPE !

1986QV · 27/12/12

có mỗi file quen chưa up a/e giúp sao được. hjhj. Em up rồi mọi người giúp em, viết code vậy.

qv7tb · 28/12/12

Bài này khó bác phải nhờ cao thủ GPE thôi. hjchjc

Ba Tê · 28/12/12

1986QV đã viết:
em lại giả sử lại 1 điều khi các ký tự chưa được sắp xếp như sheet2 thì làm sao paste vào c8 được bác. ví dụ A,B là 2 ký tự được lấy theo thứ tự của 8 ký tự trên.
Các điều kiện chỉ yêu cầu 1 chiều từ A=>>B (A trùng B ở điểm đi được phép đánh dấu) là bài toán sheet 2 được giải quyết. Bài toán ngược lại từ B=>>A tại sheet 3 phải được giải quyết. Và cả sheet 2,3 sử dụng vùng (mảng )lớn không giới hạn. Mong A/E forum đưa ra ý kiến
Cảm ơn A/E quan tâm và giúp đỡ!

Híc!
Hỏi cái gì thì phải chính xác 1 lần,Hỏi rồi "Em lại giả sử lại 1 điều...", rồi "Em lại giả sử...".
Có ai trên đời này lại kiên nhẫn như thế không nhỉ?

1986QV · 29/12/12

sorry các bác nha. em nhầm lẫn trong bài toán nên nhờ ý kiến các bác chỉnh sửa và viết giúp code cho bài toán. Rất mong a/e forum GPE quan tâm và giúp đỡ.
Cảm ơn mọi người forum GPE quan tâm và giúp đỡ

qv7tb · 5/2/13

huuthang_bd đã viết:
Xem trong file nhé bạn.

Em đã đọc bài viết trên và em nhờ bác viết cho cái code VBA cho cách ghép 3 mã không còn là 2 mã như trước nữa. cách sắp xếp và yêu cầu vẫn như trước(bài toán đầu tiên mà bác huuthang_bd viết rất ok) em có gửi qua file kèm cách ghép. Nhờ bác và a/e GPE xem xét giúp.
Cảm ơn bác và a/e GPE quan tâm và giúp đỡ.

qv7tb · 22/2/13

em nhờ các cao thủ cho em ý kiến về bài toán này với(Qua 1 năm rồi không ai trả lời là sao? hjhj)
THanks các bác GPE !!!

concogia · 22/2/13

qv7tb đã viết:
em nhờ các cao thủ cho em ý kiến về bài toán này với(Qua 1 năm rồi không ai trả lời là sao? hjhj)
THanks các bác GPE !!!

Một ý kiến:
Trong bài hát Phượng...xanh đỏ tím gì đó có câu: AI CŨNG HÔNG HIỂU, CHỈ CÓ MỘT NGƯỜI MỚI HIỂU
Híc, bạn hỏi bài nhiều rồi mà vẫn hông biết vì sao không ai trả lời bạn
Lại "híc" cái nữa

qv7tb · 22/2/13

Bài hát bác concogia nhắc đó ah: bài thời hoa đỏ( tinh yêu khờ dại) hjhj

qv7tb đã viết:
Em đã đọc bài viết trên và em nhờ bác viết cho cái code VBA cho cách ghép 3 mã không còn là 2 mã như trước nữa. cách sắp xếp và yêu cầu vẫn như trước(bài toán đầu tiên mà bác huuthang_bd viết rất ok) em có gửi qua file kèm cách ghép. Nhờ bác và a/e GPE xem xét giúp.
Cảm ơn bác và a/e GPE quan tâm và giúp đỡ.

A/E forum GPE viết dùm code VBA cho file sau. File có 2 sheet, sheet 1 có chứa bảng số liệu, sheet 2 là kết quả thỏa mãn những điều kiện sau:
1) Ghép 3 ký tự trong tất cả các ký tự có mặt trên bảng sheet 1.
2) Đánh dấu sự xuất hiện của số bất kỳ nào thuộc 3 ký tự đã ghép từ ở bảng trong sheet 1 theo dk sau:
A,B,C là 3 ký tự bất kỳ trong 8 ký tự thuộc sheet 1.
- khi A,B,C (A,B,C có ở bảng số liệu các giá trị "1"," ") vậy có sự giao nhau các giá trị khi ghép ký tự ấy:
1 giao "", "" giao 1, 1 giao 1 đều cho ra 1. Còn nếu "" giao "" cho ra ""
Bài toán tương tự như bác huuthang_bd giải quyết cho 2 ký tự nhưng đây sẽ là 3 ký tự.
Chân thành cảm ơn a/e forum GPE!

concogia · 22/2/13

qv7tb đã viết:
Bài hát bác concogia nhắc đó ah: bài thời hoa đỏ( tinh yêu khờ dại) hjhj

A/E forum GPE viết dùm code VBA cho file sau. File có 2 sheet, sheet 1 có chứa bảng số liệu, sheet 2 là kết quả thỏa mãn những điều kiện sau:
1) Ghép 3 ký tự trong tất cả các ký tự có mặt trên bảng sheet 1.
2) Đánh dấu sự xuất hiện của số bất kỳ nào thuộc 3 ký tự đã ghép từ ở bảng trong sheet 1 theo dk sau:
A,B,C là 3 ký tự bất kỳ trong 8 ký tự thuộc sheet 1.
- khi A,B,C (A,B,C có ở bảng số liệu các giá trị "1"," ") vậy có sự giao nhau các giá trị khi ghép ký tự ấy:
1 giao "", "" giao 1, 1 giao 1 đều cho ra 1. Còn nếu "" giao "" cho ra ""
Bài toán tương tự như bác huuthang_bd giải quyết cho 2 ký tự nhưng đây sẽ là 3 ký tự.
Chân thành cảm ơn a/e forum GPE!

Ok, hổng hiểu luôn
Bi giờ bạn thử điền vào vài kết quả ở sheet2, giải thích tại sao ra kết quả như vậy
Híc, thế nào gọi là "giao nhau", có 3 thằng A, B, C mà cứ 1 giao "", "" giao 1, 1 giao 1......thế còn một thằng nữa đâu ?????
Híc, híc, híc
Thân

qv7tb · 22/2/13

concogia đã viết:
Ok, hổng hiểu luôn
Bi giờ bạn thử điền vào vài kết quả ở sheet2, giải thích tại sao ra kết quả như vậy
Híc, thế nào gọi là "giao nhau", có 3 thằng A, B, C mà cứ 1 giao "", "" giao 1, 1 giao 1......thế còn một thằng nữa đâu ?????
Híc, híc, híc
Thân

em gửi file ví dụ y như bài toán đó chính xác luôn

concogia · 22/2/13

qv7tb đã viết:
em gửi file ví dụ y như bài toán đó chính xác luôn

Làm đại thôi, chứ cũng chẳng hiểu "giao" là như thế nào nữa, cứ nhìn kết quả ví dụ là "phang"
À, mà cái file này là cái gì vậy bạn, nhìn chẳng biết nó là cái chi chi nữa
Cóc vào đầu con meo meo nhé
Thân
Quên, kết quả từ [S4], để kiểm tra thôi

qv7tb · 22/2/13

concogia đã viết:
Làm đại thôi, chứ cũng chẳng hiểu "giao" là như thế nào nữa, cứ nhìn kết quả ví dụ là "phang"
À, mà cái file này là cái gì vậy bạn, nhìn chẳng biết nó là cái chi chi nữa
Cóc vào đầu con meo meo nhé
Thân
Quên, kết quả từ [S4], để kiểm tra thôi

bác ah! Bác chưa cho cái code ghép 3 ký tự bất kỳ trong 8 ký tự kia rồi xác định giao như bài mà bác huuthang_bd đã làm với 2 ký tự. Nếu không làm được ghép các nối thì xác định giao cũng không giải quyết vấn đề được bác ah! Bác xem lại và giúp em viết cho đủ bộ bài toán này. thanks bác concogia
Cảm ơn a/e forum GPE tham gia giúp đỡ!

dhn46 · 22/2/13

Không biết code này có đúng ý bạn không?

qv7tb · 22/2/13

Chuẩn luôn nhưng với 50-80 ký tự và số là kẹt luôn. hjhj. không biết có cao kiến j không. em ước tính cỡ 200000 dòng mà không tính hết được. Bác cho em ý kiến.

dhn46 · 22/2/13

qv7tb đã viết:
Chuẩn luôn nhưng với 50-80 ký tự và số là kẹt luôn. hjhj. không biết có cao kiến j không. em ước tính cỡ 200000 dòng mà không tính hết được. Bác cho em ý kiến.

Kẹt là như thế nào bạn? Bạn cứ đưa dữ liệu lên xem. Bạn thử File này xem có lỗi gì không nhé
- Điều kiện: Chập 3 mã
- Ô so sánh 1 => 12
Nói chung là cấu trúc như File ban đầu
Bạn Test rồi phản hồi kết quả nhé

qv7tb · 22/2/13

File này bác coi thử xem khối lượng lớn đó bác
Thanks bác và a/e forum GPF!

qv7tb · 22/2/13

dhn46 đã viết:
Kẹt là như thế nào bạn? Bạn cứ đưa dữ liệu lên xem. Bạn thử File này xem có lỗi gì không nhé
- Điều kiện: Chập 3 mã
- Ô so sánh 1 => 12
Nói chung là cấu trúc như File ban đầu
Bạn Test rồi phản hồi kết quả nhé

file mới đủ dữ kiện đây bác:

dhn46 · 22/2/13

qv7tb đã viết:
File này bác coi thử xem khối lượng lớn đó bác
Thanks bác và a/e forum GPF!

Bạn check với 80 dòng dữ liệu có lỗi không?
Tôi dùng hàm Giaithua để xác định số hàng của mảng dữ liệu xuất ra, trường hợp lỗi đó là n! > độ lớn biến Double.
File trên tôi test với 109 dòng dữ liệu và chưa thấy lỗi, không biết bạn thấy như thế nào?

qv7tb · 22/2/13

bác thử với file em gửi lên xem sao? Và gửi lên em xem có phải lỗi tại máy không? vì thường báo errox 7 memory?

dhn46 · 22/2/13

Để giải quyết bài toán với 256 cột dữ liệu của bạn, mình cũng đã dùng code nhưng cũng bị thông báo lỗi tại vùng màu đỏ và chưa hiểu vì sao (phỏng đoán do giới hạn của mảng chăng), dhn46 post Code lên mọi người giải thích hộ tại sao với dữ liệu bài #29 lại bị lỗi phần màu đỏ

Mã:

Sub Giao()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, Eubound As Long
Arr = Sheet1.Range("A4:IV" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents


Eubound = Giaithua(UBound(Arr, 1)) / (Giaithua(UBound(Arr, 1) - 3) * 6)
[COLOR=#ff0000]ReDim sArr(1 To Eubound, 1 To UBound(Arr, 2) + 3)[/COLOR]
For i = 1 To UBound(Arr, 1)
    For j = i + 1 To UBound(Arr, 1)
        For k = j + 1 To UBound(Arr, 1)
            iR = iR + 1
            sArr(iR, 1) = Arr(i, 1)
            sArr(iR, 2) = Arr(j, 1)
            sArr(iR, 3) = Arr(k, 1)
            For jC = 2 To UBound(Arr, 2)
                If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then
                    sArr(iR, jC + 2) = 1
                End If
            Next
        Next
    Next
Next
Sheet2.[t4].Resize(UBound(sArr, 1), UBound(sArr, 2)) = sArr
End Sub


Public Function Giaithua(n As Integer)
    Dim T As Double
    If n = 0 Then
        T = 1
    Else
        T = 1
        For i = 1 To n
            T = T * i
        Next i
        Giaithua = T
    End If
End Function

qv7tb · 25/2/13

các bác forum GPE vào xem và ngâm cứu sửa lỗi Giúp dhn46 và chút
Thanks a/e forum GPE!!!

qv7tb · 23/3/13

dhn46 đã viết:

Để giải quyết bài toán với 256 cột dữ liệu của bạn, mình cũng đã dùng code nhưng cũng bị thông báo lỗi tại vùng màu đỏ và chưa hiểu vì sao (phỏng đoán do giới hạn của mảng chăng), dhn46 post Code lên mọi người giải thích hộ tại sao với dữ liệu bài #29 lại bị lỗi phần màu đỏ

Mã:

Sub Giao()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, Eubound As Long
Arr = Sheet1.Range("A4:IV" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents


Eubound = Giaithua(UBound(Arr, 1)) / (Giaithua(UBound(Arr, 1) - 3) * 6)
[COLOR=#ff0000]ReDim sArr(1 To Eubound, 1 To UBound(Arr, 2) + 3)[/COLOR]
For i = 1 To UBound(Arr, 1)
    For j = i + 1 To UBound(Arr, 1)
        For k = j + 1 To UBound(Arr, 1)
            iR = iR + 1
            sArr(iR, 1) = Arr(i, 1)
            sArr(iR, 2) = Arr(j, 1)
            sArr(iR, 3) = Arr(k, 1)
            For jC = 2 To UBound(Arr, 2)
                If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then
                    sArr(iR, jC + 2) = 1
                End If
            Next
        Next
    Next
Next
Sheet2.[t4].Resize(UBound(sArr, 1), UBound(sArr, 2)) = sArr
End Sub


Public Function Giaithua(n As Integer)
    Dim T As Double
    If n = 0 Then
        T = 1
    Else
        T = 1
        For i = 1 To n
            T = T * i
        Next i
        Giaithua = T
    End If
End Function

A/E forum vào coi xem code bị lỗi sao và sử lỗi dùm em. thanks a/e forum!!!

dhn46 · 23/3/13

qv7tb đã viết:
A/E forum vào coi xem code bị lỗi sao và sử lỗi dùm em. thanks a/e forum!!!

Bạn ah, mình cũng Mail nhờ 1 vài cao thủ GPE thắc mắc về vẫn đề trên, cuối cùng được Bác SiwTom chỉ ra điểm vấn đề: dưới đây là 1 phần Mail của bác giải thích hiện tượng trên

Chào bạn,

Tôi đính kèm code ở bài 32 vào tập tin ở bài 29 nhưng chỉ cho chạy tới dòng

Code:

ReDim sArr(1 To Eubound, 1 To UBound(Arr, 2) + 3)
thì bị lỗi "out of memory"
Dễ hiểu thôi.

mảng sArr có 161700 dòng và 259 cột, tức có 161700*259 = 41880300 phần tử. Bạn khai báo sArr vậy tôi hiểu mỗi phần tử là 1 Variant, tức chiếm 16 bai. Tổng cộng mảng sArr chiếm 41880300*16 = 670084800 bai = 639 MB. Với máy của tôi có 1GB RAM thì sau khi khởi động system và các chương trình cần thiết thì lượng RAM còn free chắc chắn < 639 MB kia. Mà để "toàn bộ" hoạt động thì RAM cũng phải còn trống một lượng nào đó nữa.

Nói chung phương pháp của mình đưa ra đối với dữ liệu lớn là: "không thực hiện được". Bạn nên chờ xem có cao thủ nào ra tay thôi.

vodoi2x · 23/3/13

dhn46 đã viết:
Bạn ah, mình cũng Mail nhờ 1 vài cao thủ GPE thắc mắc về vẫn đề trên, cuối cùng được Bác SiwTom chỉ ra điểm vấn đề: dưới đây là 1 phần Mail của bác giải thích hiện tượng trên

Nói chung phương pháp của mình đưa ra đối với dữ liệu lớn là: "không thực hiện được". Bạn nên chờ xem có cao thủ nào ra tay thôi.

GPE hồi này đọc toàn bài toán phi thực tế nhỉ, chẳng hiểu ứng dụng cái gì???

Bài toán như là bài toán thử chơi vậy???

nếu vẫn sử dụng thuật toan đó, sao dhn46 không sử dụng code như sau,

Thử code sau cho số liệu lớn

(không cần tính giai thừa giai theo gì cả)

PHP:

Sub Giao2()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long
Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents
Application.ScreenUpdating = False
ReDim sArr(1 To 1, 1 To UBound(Arr, 2) + 3)
For i = 1 To UBound(Arr, 1)
    For j = i + 1 To UBound(Arr, 1)
        For k = j + 1 To UBound(Arr, 1)
            iR = iR + 1
            If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub
            sArr(1, 1) = Arr(i, 1)
            sArr(1, 2) = Arr(j, 1)
            sArr(1, 3) = Arr(k, 1)
            For jC = 2 To UBound(Arr, 2)
                If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then _
                    sArr(1, jC + 2) = 1
            Next
            Sheet2.[t4].Offset(iR - 1).Resize(, UBound(sArr, 2)) = sArr
        Next
    Next
Next
Application.ScreenUpdating = True
MsgBox "ket thuc"
End Sub

Có thể cải tiến thuật toán trên cho nhanh - để không phải gán xuống sheet từng hàng, thì ta mở sArr có kích cỡ 1000 dòng chẳng hạn thì cứ đầy 1000 lại gán xuống sheets - rùi lại lặp lại cho bước sau cho đến hết -dhn46 thử làm theo hướng đó xem sao

lưu ý bài toán này nếu theo đúng như thuật toán dhn 46 thì nó sẽ là sô tổ hợp chập 3 của ...n dòng (n sô dòng số liệu gốc) ==> sẽ rất lớn, có trường hợp sheet excel không chứa hết, - còn nếu còn chứa được thì code này có thể tiếp tục chạy - bằng không sẽ thông báo kết thúc

qv7tb · 24/3/13

vodoi2x đã viết:
GPE hồi này đọc toàn bài toán phi thực tế nhỉ, chẳng hiểu ứng dụng cái gì???

Bài toán như là bài toán thử chơi vậy???

nếu vẫn sử dụng thuật toan đó, sao dhn46 không sử dụng code như sau,

Thử code sau cho số liệu lớn

(không cần tính giai thừa giai theo gì cả)

PHP:

Sub Giao2() Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row) Sheet2.Range("T4").CurrentRegion.ClearContents Application.ScreenUpdating = False ReDim sArr(1 To 1, 1 To UBound(Arr, 2) + 3) For i = 1 To UBound(Arr, 1) For j = i + 1 To UBound(Arr, 1) For k = j + 1 To UBound(Arr, 1) iR = iR + 1 If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub sArr(1, 1) = Arr(i, 1) sArr(1, 2) = Arr(j, 1) sArr(1, 3) = Arr(k, 1) For jC = 2 To UBound(Arr, 2) If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then _ sArr(1, jC + 2) = 1 Next Sheet2.[t4].Offset(iR - 1).Resize(, UBound(sArr, 2)) = sArr Next Next Next Application.ScreenUpdating = True MsgBox "ket thuc" End Sub

Có thể cải tiến thuật toán trên cho nhanh - để không phải gán xuống sheet từng hàng, thì ta mở sArr có kích cỡ 1000 dòng chẳng hạn thì cứ đầy 1000 lại gán xuống sheets - rùi lại lặp lại cho bước sau cho đến hết -dhn46 thử làm theo hướng đó xem sao

lưu ý bài toán này nếu theo đúng như thuật toán dhn 46 thì nó sẽ là sô tổ hợp chập 3 của ...n dòng (n sô dòng số liệu gốc) ==> sẽ rất lớn, có trường hợp sheet excel không chứa hết, - còn nếu còn chứa được thì code này có thể tiếp tục chạy - bằng không sẽ thông báo kết thúc

Code bác viết cho n dòng chuẩn, với n cột chắc Ram 8G mới đủ. em chạy rồi khoảng 1000 cột ok mất 1,3G Ram. với 2000 cột mất 2,7G Ram, 3000 cột báo lỗi luôn( bộ nhớ ít quá em có 4G Ram thôi bác).Hai nữa là ô nào cũng phết số 1 vào mà không loại như điều kiện bài yêu cầu bác ah! Bác xem cho em có cách nào hay hơn với dung ấy không? Hjhj(hơi đòi hỏi chút bác thông cảm.
Cảm ơn a/e forum GPE!!!

vodoi2x · 24/3/13

qv7tb đã viết:
Code bác viết cho n dòng chuẩn, với n cột chắc Ram 8G mới đủ. em chạy rồi khoảng 1000 cột ok mất 1,3G Ram. với 2000 cột mất 2,7G Ram, 3000 cột báo lỗi luôn( bộ nhớ ít quá em có 4G Ram thôi bác).Hai nữa là ô nào cũng phết số 1 vào mà không loại như điều kiện bài yêu cầu bác ah! Bác xem cho em có cách nào hay hơn với dung ấy không? Hjhj(hơi đòi hỏi chút bác thông cảm.
Cảm ơn a/e forum GPE!!!

ah,

sửa lại như sau

PHP:

Sub Giao2()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long
Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents
Application.ScreenUpdating = False

For i = 1 To UBound(Arr, 1)
    For j = i + 1 To UBound(Arr, 1)
        For k = j + 1 To UBound(Arr, 1)
             ReDim sArr(1 To 1, 1 To UBound(Arr, 2) + 3)
             iR = iR + 1
            If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub
            sArr(1, 1) = Arr(i, 1)
            sArr(1, 2) = Arr(j, 1)
            sArr(1, 3) = Arr(k, 1)
            For jC = 2 To UBound(Arr, 2)
                If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then _
                    sArr(1, jC + 2) = 1
            Next
            Sheet2.[t4].Offset(iR - 1).Resize(, UBound(sArr, 2)) = sArr
        Next
    Next
Next
Application.ScreenUpdating = True
MsgBox "ket thuc"
End Sub

con RAM hay k thi xem lại cách đặt vấn đề bt

vodoi2x · 24/3/13

Cải thiện tốc độ 1 tý

PHP:

Sub Giao2()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, Tg As Byte, n As Long, m As Long
Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents
Application.ScreenUpdating = False
m = UBound(Arr, 1): n = UBound(Arr, 2)
For i = 1 To m
    sArr(1, 1) = Arr(i, 1)
    For j = i + 1 To m
        sArr(1, 2) = Arr(j, 1)
        Tg = Arr(i, jC) + Arr(j, jC)
        For k = j + 1 To m
            ReDim sArr(1 To 1, 1 To n + 3)
            iR = iR + 1
            If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub
            sArr(1, 3) = Arr(k, 1)
            For jC = 2 To n
                If Tg + Arr(k, jC) > 0 Then sArr(1, jC + 2) = 1
            Next
            Sheet2.[t4].Offset(iR - 1).Resize(, n) = sArr
        Next
    Next
Next
Application.ScreenUpdating = True
MsgBox "ket thuc"
End Sub

Bạn muốn cải thiện, xử lý số liệu lớn, thì phải nói cụ thể hơn:
- đây là bài toán gì, ứng dụng gì
- Có phải đây chỉ là kết quả trung gian không - nếu đúng thì phải nói bài toán ứng dụng đầy đủ - vì khâu trung gian thường tốn nhiều lưu trữ ==> đầy đủ có thể có thuật toán khác
- Mô tả bài toán đầy đủ các khả năng, cả về độ phức tạp lẫn, quy mô dữ liệu
- Hiện giờ thấy chứa trong sheet KQ có rất nhiều ô trống trống (điều tối kỵ trong việc xử lý dữ liệu lớn)

==> tùy bạn thui, còn dữ liệu lớn thế này đã ăn thua gì đâu so với các bài toán lớn của máy tính -- nên kiểu gì cũng có cách

dhn46 · 24/3/13

Anh Vodoi2x
Hình như còn chút chưa ổn với Code bài #39
1/ sArr chưa khai báo độ lớn nên báo lỗi
2/ jC = 0 gây ra lỗi Arr(i,jC)
- Dhn46 thấy ý đồ của bạn này nếu xử lý trên máy cùi của em thì không ăn thua. Chắc sẽ phải có thuật toán khác để xử lý.
Cảm ơn anh!

vodoi2x · 24/3/13

dhn46 đã viết:
Anh Vodoi2x
Hình như còn chút chưa ổn với Code bài #39
1/ sArr chưa khai báo độ lớn nên báo lỗi
2/ jC = 0 gây ra lỗi Arr(i,jC)
- Dhn46 thấy ý đồ của bạn này nếu xử lý trên máy cùi của em thì không ăn thua. Chắc sẽ phải có thuật toán khác để xử lý.
Cảm ơn anh!

Đúng rùi, đúng là viết code trên đầu gối (như siwtom nói) chưa test nên bị thế hihii, sửa lại xem code sau

Bài toán lớn, nhưng đưa ra 1 góc trung gian (chắc vậy) - thì thuật toán sao ngon lành cành đào được - quan trong NGƯỜI HỎI không nói rõ gốc gác thui

PHP:

Sub Giao2()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, Tg As Byte, n As Long, m As Long
Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents
Application.ScreenUpdating = False
m = UBound(Arr, 1): n = UBound(Arr, 2)
ReDim sArr(1 To 1, 1 To n + 3)
For i = 1 To m
    sArr(1, 1) = Arr(i, 1)
    For j = i + 1 To m
        sArr(1, 2) = Arr(j, 1)
        Tg = Arr(i, jC) + Arr(j, jC)
        For k = j + 1 To m
            iR = iR + 1
            If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub
            sArr(1, 3) = Arr(k, 1)
            For jC = 2 To n
                If Tg + Arr(k, jC) > 0 Then 
                                sArr(1, jC + 2) = 1
                Else
                                sArr(1, jC + 2) = ""
                End If
            Next
            Sheet2.[t4].Offset(iR - 1).Resize(, n) = sArr
        Next
    Next
Next
Application.ScreenUpdating = True
MsgBox "ket thuc"
End Sub

C

qv7tb · 24/3/13

sub giao2()
dim arr, sarr, i as long, j as long, k as long, ir as long, jc as long, tg as byte, n as long, m as long
arr = sheet1.range("a4:m" & sheet1.range("a65536").end(3).row)
sheet2.range("t4").currentregion.clearcontents
application.screenupdating = false
m = ubound(arr, 1): N = ubound(arr, 2)
redim sarr(1 to 1, 1 to n + 3)
for i = 1 to m
sarr(1, 1) = arr(i, 1)
for j = i + 1 to m
sarr(1, 2) = arr(j, 1)
tg = arr(i, jc) + arr(j, jc)
for k = j + 1 to m
ir = ir + 1
if ir > sheet2.rows.count - 10 then msgbox "het so dong cua sheet excel": Exit sub
sarr(1, 3) = arr(k, 1)
for jc = 2 to n
if tg + arr(k, jc) > 0 then
sarr(1, jc + 2) = 1
else
sarr(1, jc + 2) = ""
end if
next
sheet2.[t4].offset(ir - 1).resize(, n) = sarr
next
next
next
application.screenupdating = true
msgbox "ket thuc"
end sub

bác xem chỗ màu đỏ này chuẩn chuă chạy báo lỗi.
Thanks gpe!

vodoi2x · 24/3/13

qv7tb đã viết:
bác xem chỗ màu đỏ này chuẩn chuă chạy báo lỗi.
Thanks gpe!

đúng là SAI toe toet, vậy bạn dùng code này

PHP:

Sub Giao3()
Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, n As Long, m As Long
Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row)
Sheet2.Range("T4").CurrentRegion.ClearContents
Application.ScreenUpdating = False
m = UBound(Arr, 1): n = UBound(Arr, 2)
ReDim sArr(1 To 1, 1 To n + 3)
For i = 1 To m
    sArr(1, 1) = Arr(i, 1)
    For j = i + 1 To m
        sArr(1, 2) = Arr(j, 1)
        
        For k = j + 1 To m
            iR = iR + 1
            If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub
            sArr(1, 3) = Arr(k, 1)
            For jC = 2 To n
                If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then
                        sArr(1, jC + 2) = 1
                Else: sArr(1, jC + 2) = "": End If
            Next
            Sheet2.[t4].Offset(iR - 1).Resize(, n) = sArr
        Next
    Next
Next
Application.ScreenUpdating = True
MsgBox "ket thuc"
End Sub

---------------
sao k trả lời các câu hỏi trên
#
Bạn muốn cải thiện, xử lý số liệu lớn, thì phải nói cụ thể hơn:
- đây là bài toán gì, ứng dụng gì
- Có phải đây chỉ là kết quả trung gian không - nếu đúng thì phải nói bài toán ứng dụng đầy đủ - vì khâu trung gian thường tốn nhiều lưu trữ ==> đầy đủ có thể có thuật toán khác
- Mô tả bài toán đầy đủ các khả năng, cả về độ phức tạp lẫn, quy mô dữ liệu
- Hiện giờ thấy chứa trong sheet KQ có rất nhiều ô trống trống (điều tối kỵ trong việc xử lý dữ liệu lớn)

==> tùy bạn thui, còn dữ liệu lớn thế này đã ăn thua gì đâu so với các bài toán lớn của máy tính -- nên kiểu gì cũng có cách#

qv7tb · 24/3/13

vodoi2x đã viết:
đúng là SAI toe toet, vậy bạn dùng code này

PHP:

Sub Giảo2() Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, n As Long, m As Long Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row) Sheet2.Range("T4").CurrentRegion.ClearContents Application.ScreenUpdating = False m = UBound(Arr, 1): n = UBound(Arr, 2) ReDim sArr(1 To 1, 1 To n + 3) For i = 1 To m sArr(1, 1) = Arr(i, 1) For j = i + 1 To m sArr(1, 2) = Arr(j, 1) For k = j + 1 To m iR = iR + 1 If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub sArr(1, 3) = Arr(k, 1) For jC = 2 To n If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then sArr(1, jC + 2) = 1 Else: sArr(1, jC + 2) = "": End If Next Sheet2.[t4].Offset(iR - 1).Resize(, n) = sArr Next Next Next Application.ScreenUpdating = True MsgBox "ket thuc" End Sub

---------------
sao k trả lời các câu hỏi trên
#
Bạn muốn cải thiện, xử lý số liệu lớn, thì phải nói cụ thể hơn:
- đây là bài toán gì, ứng dụng gì
- Có phải đây chỉ là kết quả trung gian không - nếu đúng thì phải nói bài toán ứng dụng đầy đủ - vì khâu trung gian thường tốn nhiều lưu trữ ==> đầy đủ có thể có thuật toán khác
- Mô tả bài toán đầy đủ các khả năng, cả về độ phức tạp lẫn, quy mô dữ liệu
- Hiện giờ thấy chứa trong sheet KQ có rất nhiều ô trống trống (điều tối kỵ trong việc xử lý dữ liệu lớn)

==> tùy bạn thui, còn dữ liệu lớn thế này đã ăn thua gì đâu so với các bài toán lớn của máy tính -- nên kiểu gì cũng có cách#

Đúng bài toán xử lý với số liệu lớn, sử cho tần số ứng suất. Mình chỉ lấy ứng suất xuất hiện, theo biên tối thiểu để thống kê. Mình có đưa file ví dụ cụ thể rồi đó, mình nghĩ ô trống sẽ rất nhiều nên không biết có cách nào tối ưu được không. Bạn và a/e forum ra tay giúp thôi.
Thanks GPE!

qv7tb · 24/3/13

vodoi2x đã viết:
đúng là SAI toe toet, vậy bạn dùng code này

PHP:

Sub Giảo2() Dim Arr, sArr, i As Long, j As Long, k As Long, iR As Long, jC As Long, n As Long, m As Long Arr = Sheet1.Range("A4:M" & Sheet1.Range("A65536").End(3).Row) Sheet2.Range("T4").CurrentRegion.ClearContents Application.ScreenUpdating = False m = UBound(Arr, 1): n = UBound(Arr, 2) ReDim sArr(1 To 1, 1 To n + 3) For i = 1 To m sArr(1, 1) = Arr(i, 1) For j = i + 1 To m sArr(1, 2) = Arr(j, 1) For k = j + 1 To m iR = iR + 1 If iR > Sheet2.Rows.Count - 10 Then MsgBox "HET SO DONG CUA SHEET EXCEL": Exit Sub sArr(1, 3) = Arr(k, 1) For jC = 2 To n If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then sArr(1, jC + 2) = 1 Else: sArr(1, jC + 2) = "": End If Next Sheet2.[t4].Offset(iR - 1).Resize(, n) = sArr Next Next Next Application.ScreenUpdating = True MsgBox "ket thuc" End Sub

---------------
sao k trả lời các câu hỏi trên
#
Bạn muốn cải thiện, xử lý số liệu lớn, thì phải nói cụ thể hơn:
- đây là bài toán gì, ứng dụng gì
- Có phải đây chỉ là kết quả trung gian không - nếu đúng thì phải nói bài toán ứng dụng đầy đủ - vì khâu trung gian thường tốn nhiều lưu trữ ==> đầy đủ có thể có thuật toán khác
- Mô tả bài toán đầy đủ các khả năng, cả về độ phức tạp lẫn, quy mô dữ liệu
- Hiện giờ thấy chứa trong sheet KQ có rất nhiều ô trống trống (điều tối kỵ trong việc xử lý dữ liệu lớn)

==> tùy bạn thui, còn dữ liệu lớn thế này đã ăn thua gì đâu so với các bài toán lớn của máy tính -- nên kiểu gì cũng có cách#

Code trên khi ghép tai sheet2 đã không hết thiếu 2 cột tai sheet 1. Bạn xem lại cái
Đúng bài toán xử lý với số liệu lớn, sử cho tần số ứng suất. Mình chỉ lấy ứng suất xuất hiện, theo biên tối thiểu để thống kê. Mình có đưa file ví dụ cụ thể rồi đó, mình nghĩ ô trống sẽ rất nhiều nên không biết có cách nào tối ưu được không. Bạn và a/e forum ra tay giúp thôi.
Thanks GPE!

vodoi2x · 24/3/13

qv7tb đã viết:
Code trên khi ghép tai sheet2 đã không hết thiếu 2 cột tai sheet 1. Bạn xem lại cái
Đúng bài toán xử lý với số liệu lớn, sử cho tần số ứng suất. Mình chỉ lấy ứng suất xuất hiện, theo biên tối thiểu để thống kê. Mình có đưa file ví dụ cụ thể rồi đó, mình nghĩ ô trống sẽ rất nhiều nên không biết có cách nào tối ưu được không. Bạn và a/e forum ra tay giúp thôi.
Thanks GPE!

Thiếu hay không là bạn định nghĩa cái Arr đó bạn sửa code được mà
sửa chỗ này nhé

For jC = 2 To n +2
If Arr(i, jC) + Arr(j, jC) + Arr(k, jC) > 0 Then
sArr(1, jC + 2) = 1
Else: sArr(1, jC + 2) = "":

End If
Next
Sheet2.[t4].Offset(iR - 1).Resize(, n+2) = sArr

thêm cái +2 đó

Kết quả cuối cùng cần là gì, làm gì có chuyện cả cái sheet2 to đúng tổ hợp chập 3 như thế??

qv7tb · 25/3/13

Chuẩn chưa bác ? sao em chỉnh rồi là hỏng chạy vào đâu.bác và các cao thủ nghiên cứu cho em cái code chuẩn nha!

vodoi2x · 25/3/13

qv7tb đã viết:
Chuẩn chưa bác ? sao em chỉnh rồi là hỏng chạy vào đâu.bác và các cao thủ nghiên cứu cho em cái code chuẩn nha!

Với phương châm chia ra để trị, chấp nhận là can thiệp của người dùng vào

sheet1 là data của bạn

sheet2 là kết quả sẽ chạy kết hợp từ 1 đến 1 tức là lấy dòng 1 đi kết hợp với các dòng còn lại (2,3,...100) để được tổ hợp 3 và xuất kết quả, tương tự sheet 3 (2 đến 2) .... đến ví dụ cuối (80-98) - khi này càng cuối thì càng ít tổ hợp kết hợp nên ta có thể chạy cho nhiều dòng ở đây là 98-80+1=19 dòng

Các thông số nhập

Thứ tự dòng chạy TỪ - ĐẾN: 1 1
Số dòng ghi xuống Sheet: 500

Các thông số này có ghi chú trong file,

chú ý
Nếu muốn tạo sheet kết quả tiếp theo chỉ cần copy dòng đầu tiên cho F1-O1 sanng và thay đổi THÔNG SỐ NHẬP hợp lý - bấm Ctrl+r là chạy chương trình được

Với cách chia để trị thế này thì đảm bảo cho phép chạy bài toán lớn bao nhiêu cũng được - và chỉ cần người dùng chịu khó chạy theo từng đoạn, với data hiện thời chắc bạn chạy trong 1 tiếng là xong chứ mấy.

qv7tb · 25/3/13

vodoi2x đã viết:
Với phương châm chia ra để trị, chấp nhận là can thiệp của người dùng vào

sheet1 là data của bạn

sheet2 là kết quả sẽ chạy kết hợp từ 1 đến 1 tức là lấy dòng 1 đi kết hợp với các dòng còn lại (2,3,...100) để được tổ hợp 3 và xuất kết quả, tương tự sheet 3 (2 đến 2) .... đến ví dụ cuối (80-98) - khi này càng cuối thì càng ít tổ hợp kết hợp nên ta có thể chạy cho nhiều dòng ở đây là 98-80+1=19 dòng

Các thông số nhập

Các thông số này có ghi chú trong file,

chú ý
Nếu muốn tạo sheet kết quả tiếp theo chỉ cần copy dòng đầu tiên cho F1-O1 sanng và thay đổi THÔNG SỐ NHẬP hợp lý - bấm Ctrl+r là chạy chương trình được

Với cách chia để trị thế này thì đảm bảo cho phép chạy bài toán lớn bao nhiêu cũng được - và chỉ cần người dùng chịu khó chạy theo từng đoạn, với data hiện thời chắc bạn chạy trong 1 tiếng là xong chứ mấy.

Cách bác làm là đúng, nhưng chưa chuẩn ở chỗ trong ví dụ có 100 ký tự tương đương tổ hợp 3 của 100 tương đương 161700 hàng ở sheet 2,sheet 3,sheet(2) , cuoi cung. nhưng bài toán bác chỉ cho viết cho 18000 vậy còn thiếu 161700-18000=143700 trường hợp chưa xảy ra. Nếu vậy sử dụng code dhn46 chia ra làm 3 lần ok vơi tất cả dữ liệu. em chỉ lấy dữ liệu khoảng 3000- 5000 cột*100-250 hàng tại sheet1 sheet 2 làm 5000*161700-5000*2883000. là cũng vật vẫ rồi bác ah!
Rất mong các bô lão tiền bối vào trợ giúp em cái
Thanks a/e GPE!

vodoi2x · 25/3/13

qv7tb đã viết:
Cách bác làm là đúng, nhưng chưa chuẩn ở chỗ trong ví dụ có 100 ký tự tương đương tổ hợp 3 của 100 tương đương 161700 hàng ở sheet 2,sheet 3,sheet(2) , cuoi cung. nhưng bài toán bác chỉ cho viết cho 18000 vậy còn thiếu 161700-18000=143700 trường hợp chưa xảy ra. Nếu vậy sử dụng code dhn46 chia ra làm 3 lần ok vơi tất cả dữ liệu. em chỉ lấy dữ liệu khoảng 3000- 5000 cột*100-250 hàng tại sheet1 sheet 2 làm 5000*161700-5000*2883000. là cũng vật vẫ rồi bác ah!
Rất mong các bô lão tiền bối vào trợ giúp em cái
Thanks a/e GPE!

Không hiểu ý bạn, sao lại thiếu dòng

ví dụ thích gõ từ 1 -98 thì 100 dòng sẽ đưa vào tổ hợp - nhưng khi đó có thể treo máy

vậy lên phải làm nhiều bước ví dụ 1-2 3-4 5-6 ,.... 50-60,...60-75,... 75-98 thế là xong - cộng nhiều sheet là đủ 161700 dòng (con số bạn ước tính)

????
hay ý bạn khác, vẫn thuật toán từ bài dhn46 đó bạn, chỉ có chia ra để giảm khối lượng mỗi lần tính thôi,

qv7tb · 25/3/13

file bác gửi lên ấy. sheet2 chạy hết chữ đầu là A, sau là sheet 3 là B, sheet3(2) là C, sheet cuoicung la hêt: tất cả chỉ có 4851*4=19404. Bác đưa là ví dụ để giải quyết từng phần bài toán.

vodoi2x · 25/3/13

qv7tb đã viết:
file bác gửi lên ấy. sheet2 chạy hết chữ đầu là A, sau là sheet 3 là B, sheet3(2) là C, sheet cuoicung la hêt: tất cả chỉ có 4851*4=19404. Bác đưa là ví dụ để giải quyết từng phần bài toán.

không phải sheet cuối cùng đâu - đó là ví dụ

theo đây

chú ý
Nếu muốn tạo sheet kết quả tiếp theo chỉ cần copy dòng đầu tiên cho F1-O1 sanng và thay đổi THÔNG SỐ NHẬP hợp lý - bấm Ctrl+r là chạy chương trình được

bạn phải tiếp tục chứ - làm sheet 4 cho 4-4
bạn phải tiếp tục chứ - làm sheet 5 cho 5-5
.........................
bạn phải tiếp tục chứ - làm sheet 10 cho 10-10
....
bạn phải tiếp tục chứ - làm sheet 11 cho 11-12
bạn phải tiếp tục chứ - làm sheet 12 cho 13-14
..........
bạn phải tiếp tục chứ - làm sheet 19 cho 20-21
bạn phải tiếp tục chứ - làm sheet 20 cho 22-24
bạn phải tiếp tục chứ - làm sheet 21 cho 25-27
..........

bạn phải tiếp tục chứ - làm sheet ... cho 50-55
bạn phải tiếp tục chứ - làm sheet ... cho 56-61
bạn phải tiếp tục chứ - làm sheet ... cho 62-70
bạn phải tiếp tục chứ - làm sheet ... cho 71-80
bạn phải tiếp tục chứ - làm sheet CUỐI cho 81-98 thế là hết -- càng về sau khoảng cách càng lớn (vì khi đó số tổ hợp giảm đi)
(đến 98 thui, vì nó sẽ kết hợp với 99 100 )

THẾ MỚI ĐỦ SỐ DÒNG - CHẠY hết khả năng tổ hợp
---------------
Bạn hiểu chưa, tùy quy mô mà TỪ-ĐẾN sẽ lớn hay nhỏ - dữ liệu hiện giờ đến hơn 2300 cột nên quy mô phải từ 1 hoặc cùng lém từ 2 dòng 1 lần

như thế thay vì chạy 1 lần bài toán lớn (treo máy) ta tách ra chạy nhiều lần nhiều lần - thì sẽ giải quyết được đó - Và hơn nữa ai xem số liệu nhiều cả sheet to to nhiều dòng được (kiểu gì chả phải lọc ra để phân tích)

vodoi2x · 25/3/13

Ví dụ có thể chạy theo list sau

PHP:

sheet 2   :  1-1
sheet 3   :  2-2
sheet 4   :  3-3
sheet 5   :  4-4
sheet 6   :  5-5
sheet 7   :  6-6
sheet 8   :  7-7
sheet 9   :  8-8
sheet 10   :  9-9
sheet 11   :  10-10
sheet 12   :  11-12
sheet 13   :  13-14
sheet 14   :  15-16
sheet 15   :  17-19
sheet 16   :  20-22
sheet 17   :  23-25
sheet 18   :  26-29
sheet 19   :  30-33
sheet 20   :  34-37
sheet 21   :  38-42
sheet 22   :  43-47
sheet 23   :  48-53
sheet 24   :  54-59
sheet 25   :  60-68
sheet 26   :  69-77
sheet 27   :  78-98

là đạt kết quả

huuthang_bd · 25/3/13

Bạn chạy thử file này. Tôi chỉ thử với khoản 100 cột dữ liệu. Không có kiên nhẫn ngồi đợi nó chạy mấy ngàn cột. Bạn cũng nên thử với số cột từ ít tới nhiều.

qv7tb · 25/3/13

luôn hiện số 1 va ok chạy tiếp vậy anh

huuthang_bd · 25/3/13

qv7tb đã viết:
luôn hiện số 1 va ok chạy tiếp vậy anh

Tôi quên. Bạn mở code lên tìm dòng Msgbox 1 rồi xoá đi.

Code VBA ghép nối và thống kê giữa 2 sheet (1 người xem)

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

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

File đính kèm

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Thành viên hoạt động

Cạo Rồi Khỏi Gội

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

Huyền thoại GPE

Thành viên hoạt động

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

Sâu phải đào

Cạo Rồi Khỏi Gội

Thành viên hoạt động

Sâu phải đào

File đính kèm

Sâu phải đào

Gội rồi mới Cạo

Sâu phải đào

Gội rồi mới Cạo

Sâu phải đào

File đính kèm

Gội rồi mới Cạo

File đính kèm

Sâu phải đào

Hướng tới tương lai

File đính kèm

Sâu phải đào

Hướng tới tương lai

File đính kèm

Sâu phải đào

Sâu phải đào

File đính kèm

Hướng tới tương lai

Sâu phải đào

Hướng tới tương lai

Sâu phải đào

Sâu phải đào

Hướng tới tương lai

Nothing & Nothing

Sâu phải đào

Nothing & Nothing

Nothing & Nothing

Hướng tới tương lai

Nothing & Nothing

Sâu phải đào

Nothing & Nothing

Sâu phải đào

Sâu phải đào

Nothing & Nothing

Sâu phải đào

Nothing & Nothing

File đính kèm

Sâu phải đào

Nothing & Nothing

Sâu phải đào

Nothing & Nothing

Nothing & Nothing

Chuyên gia GPE

File đính kèm

Sâu phải đào

Chuyên gia GPE

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