Tìm kết quả có điều kiện trong excel2007

Liên hệ QC
S

sep_hatxel

Thành viên thường trực
Tham gia
24/5/10
Bài viết
217
Được thích
7
Mình cần kiểm tra và tìm kết quả với dữ liệu tương đối lớn nên cần phải dùng excel2007! Nhờ GPE xem và kiểm tra giúp! Xin chân thành cảm ơn! Chúc GPE luôn thắng lợi!
 

File đính kèm

  • thongke.rar
    46.8 KB · Đọc: 37
sep_hatxel đã viết:
Mình cần kiểm tra và tìm kết quả với dữ liệu tương đối lớn nên cần phải dùng excel2007! Nhờ GPE xem và kiểm tra giúp! Xin chân thành cảm ơn! Chúc GPE luôn thắng lợi!
Nhấp chuột vào đây để mở rộng...
Làm phần 1 trước, do chưa hiểu yêu cầu.
1/ Các ô tô màu có quy luật gì không, thứ tự ...
2/ [QUOTE][FONT=&quot]Mình lấy một ví dụ minh hoạ: số liệu ở[/FONT][FONT=&quot] cột B:[/FONT][FONT=&quot] vị trí [/FONT][FONT=&quot]B[/FONT][FONT=&quot]4[/FONT][FONT=&quot]B[/FONT][FONT=&quot]5 (dòng 4 ghép với dòng 5) là 1-2 muốn kiểm tra xem 1-2 có xuất hiện ở vị trí [/FONT][FONT=&quot]C[/FONT][FONT=&quot]7[/FONT][FONT=&quot]C[/FONT][FONT=&quot]8, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]12[/FONT][FONT=&quot]C[/FONT][FONT=&quot]13, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]17[/FONT][FONT=&quot]C[/FONT][FONT=&quot]18, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]22[/FONT][FONT=&quot]C[/FONT][FONT=&quot]23,...,[/FONT][FONT=&quot]C[/FONT][FONT=&quot]101[/FONT][FONT=&quot]C[/FONT][FONT=&quot]102, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]103[/FONT][FONT=&quot]C[/FONT][FONT=&quot]104,[/FONT][FONT=&quot]C[/FONT][FONT=&quot]105[/FONT][FONT=&quot]C[/FONT][FONT=&quot]106, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]107[/FONT][FONT=&quot]C[/FONT][FONT=&quot]108, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]109[/FONT][FONT=&quot]C[/FONT][FONT=&quot]110 (Tất cả chỉ xét ở 27 vị trí được tô màu) hay không? Theo bảng số liệu trên thì 1-2 xuất hiện ở 3 vị trí [/FONT][FONT=&quot]C[/FONT][FONT=&quot]7[/FONT][FONT=&quot]C[/FONT][FONT=&quot]8, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]12[/FONT][FONT=&quot]C[/FONT][FONT=&quot]13 và [/FONT][FONT=&quot]C[/FONT][FONT=&quot]47[/FONT][FONT=&quot]C[/FONT][FONT=&quot]48 (xuất hiện theo kiểu 1-2 và 2-1 đều thoả mãn) thì kết quả[/FONT][FONT=&quot] sẽ xuất sang[/FONT][FONT=&quot] sheet2 [/FONT][FONT=&quot]số lần [/FONT][FONT=&quot]sự xuất hiện là 3 ở ô[/FONT][FONT=&quot]B4 (kết quả[/FONT][FONT=&quot] bắt [/FONT][FONT=&quot]đầu[/FONT][FONT=&quot]từ cột B, cột A để trống). Nếu không xuất hiện thì[/FONT][FONT=&quot] kết quả ở sheet2 [/FONT][FONT=&quot]để trống. [/FONT][/QUOTE]
Chỉ xét B4:B5 với các ô C tô màu thôi hay xét với D, E, F, G tô màu.
Hay còn xét B6:B7...

 
ThuNghi đã viết:
Làm phần 1 trước, do chưa hiểu yêu cầu.
1/ Các ô tô màu có quy luật gì không, thứ tự ...
2/ [QUOTE][FONT=&quot]Mình lấy một ví dụ minh hoạ: số liệu ở[/FONT][FONT=&quot] cột B:[/FONT][FONT=&quot] vị trí [/FONT][FONT=&quot]B[/FONT][FONT=&quot]4[/FONT][FONT=&quot]B[/FONT][FONT=&quot]5 (dòng 4 ghép với dòng 5) là 1-2 muốn kiểm tra xem 1-2 có xuất hiện ở vị trí [/FONT][FONT=&quot]C[/FONT][FONT=&quot]7[/FONT][FONT=&quot]C[/FONT][FONT=&quot]8, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]12[/FONT][FONT=&quot]C[/FONT][FONT=&quot]13, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]17[/FONT][FONT=&quot]C[/FONT][FONT=&quot]18, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]22[/FONT][FONT=&quot]C[/FONT][FONT=&quot]23,...,[/FONT][FONT=&quot]C[/FONT][FONT=&quot]101[/FONT][FONT=&quot]C[/FONT][FONT=&quot]102, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]103[/FONT][FONT=&quot]C[/FONT][FONT=&quot]104,[/FONT][FONT=&quot]C[/FONT][FONT=&quot]105[/FONT][FONT=&quot]C[/FONT][FONT=&quot]106, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]107[/FONT][FONT=&quot]C[/FONT][FONT=&quot]108, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]109[/FONT][FONT=&quot]C[/FONT][FONT=&quot]110 (Tất cả chỉ xét ở 27 vị trí được tô màu) hay không? Theo bảng số liệu trên thì 1-2 xuất hiện ở 3 vị trí [/FONT][FONT=&quot]C[/FONT][FONT=&quot]7[/FONT][FONT=&quot]C[/FONT][FONT=&quot]8, [/FONT][FONT=&quot]C[/FONT][FONT=&quot]12[/FONT][FONT=&quot]C[/FONT][FONT=&quot]13 và [/FONT][FONT=&quot]C[/FONT][FONT=&quot]47[/FONT][FONT=&quot]C[/FONT][FONT=&quot]48 (xuất hiện theo kiểu 1-2 và 2-1 đều thoả mãn) thì kết quả[/FONT][FONT=&quot] sẽ xuất sang[/FONT][FONT=&quot] sheet2 [/FONT][FONT=&quot]số lần [/FONT][FONT=&quot]sự xuất hiện là 3 ở ô[/FONT][FONT=&quot]B4 (kết quả[/FONT][FONT=&quot] bắt [/FONT][FONT=&quot]đầu[/FONT][FONT=&quot]từ cột B, cột A để trống). Nếu không xuất hiện thì[/FONT][FONT=&quot] kết quả ở sheet2 [/FONT][FONT=&quot]để trống. [/FONT]
Nhấp chuột vào đây để mở rộng...
Chỉ xét B4:B5 với các ô C tô màu thôi hay xét với D, E, F, G tô màu.
Hay còn xét B6:B7...


[/QUOTE]

Vâng cảm ơn bạn nhiều quá! Mình xin nói rõ hơn:
1. Các ô tô màu là cố định không có quy luật (gồm 27 vị trí quy định như trong file)
2. Xét B4:B5 với các vị trí của ô C tô màu, xét xong lại tiếp tục xét B4:B6,.v.v.B4:B1203 với các vị trí của ô C tô màu,.v.v. Cứ như vậy xét lần lượt B5:B6, B5:B7,..., B6:B7,B6:B8,.v.v.. cho đến B1202:B1203 (Tổng có 719400 lần xét).
3. Sau khi xét xong cột B với các vị trí tô màu của cột C trong sheet1 và cho kết quả ở tương ứng ở cột B trong sheet2, sheet3, sheet4 rồi thì lại chuyển sang xét tiếp cột C so với các vị trí tô màu của cột D, cứ như vậy cột D so với cột E, .v.v.
4. Mình có minh hoạ cho kết quả của Vị trí B4:B5 số lần xuất hiện ở các vị trí tô màu cột C => kết quả xuất sang ở sheet2 là 3, sheet3 là 2,sheet4 là 1, còn vị trí B4:B6 không xuất hiện thì kết quả ở các sheet2,3,4 để trống,...
 
Lần chỉnh sửa cuối:
sep_hatxel đã viết:
Vâng cảm ơn bạn nhiều quá! Mình xin nói rõ hơn:
1. Các ô tô màu là cố định không có quy luật (gồm 27 vị trí quy định như trong file)
2. Xét B4:B5 với các vị trí của ô C tô màu, xét xong lại tiếp tục xét B4:B6,.v.v.B4:B1203 với các vị trí của ô C tô màu,.v.v. Cứ như vậy xét lần lượt B5:B6, B5:B7,..., B6:B7,B6:B8,.v.v.. cho đến B1202:B1203 (Tổng có 719400 lần xét).
Nhấp chuột vào đây để mở rộng...
Phần 1 phần 2 đã tính tiếp sau. Nếu đếm B4:B5 trong các cặp ô tô màu B4:B5 thì kq gán vào B4 sh2, nếu B4:B6 kq là 5 thì gán vào B?, tương tự B5:B6 thì kq gán vào đâu.
Vậy thì có đếm được thì gán tuần tự vậy.
PHP: 
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long
Dim i As Long, j As Long, k As Long, m As Long, t As Long, s As Long, n As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2()
Dim sCapSo1 As String, sCapSo2 As String
Sub DemCapSo()
fR = 4
With Sheet1
  endR = .Cells(65000, 2).End(xlUp).Row
  Set MyRng = .Range("B" & fR & ":H" & endR)
  Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.Count + 1
  If MyRng(iR, 1).Interior.Color <> 16777215 Then
    s = s + 1
    For k = 1 To 5
      ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
    Next k
    iR = iR + 2
  Else
    iR = iR + 1
  End If
Loop
n = 1: sodong = s
For k = 1 To 2 'k =5
  ReDim ArrKQ1(1 To 1000000, 1 To 1)
  ReDim ArrKQ2(1 To 1000000, 1 To 1)
  s = 0: t = 0
  For i = 1 To UBound(Arr, 1) - 1
    For j = i + 1 To UBound(Arr, 1)
      sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
      sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
      'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
      dem1 = 0: dem2 = 0
      For m = 1 To sodong 'so dong cua arrcapso'
        If ArrCapSo(m, k) = sCapSo1 Then
          dem1 = dem1 + 1
        End If
        If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
          dem2 = dem2 + 1
        End If
      Next m
      If dem1 > 0 Then
        s = s + 1
        ArrKQ1(s, 1) = dem1
      End If
      If dem2 > 0 Then
        t = t + 1
        ArrKQ2(t, 1) = dem2
      End If
    Next j
  Next i
  'gan vao
  With Sheets(n + 1)
    If t > 0 Then
      .Range("B4").Resize(t, 1) = ArrKQ2
    End If
  End With
  With Sheets(n + 2)
    If s > 0 Then
      .Range("B4").Resize(s, 1) = ArrKQ1
    End If
  End With
  n = n + 2
  Erase ArrKQ1, ArrKQ2
Next k
Erase ArrCapSo, Arr
Set MyRng = Nothing
End Sub
For k = 1 To 2 'k =5
Do mơi cho chạy k- >2
ie n=1
- Xét B với C => Sheet2, sheet3 - Sheets(n + 1)
- Xét C với D => Sheet4, sheẹt - Sheets(n + 2)
Bạn triển khai tiếp nếu OK.
 

File đính kèm

  • thongke01.rar
    34.5 KB · Đọc: 14
Lần chỉnh sửa cuối:
ThuNghi đã viết:
Phần 1 phần 2 đã tính tiếp sau. Nếu đếm B4:B5 trong các cặp ô tô màu B4:B5 thì kq gán vào B4 sh2, nếu B4:B6 kq là 5 thì gán vào B?, tương tự B5:B6 thì kq gán vào đâu.
Nhấp chuột vào đây để mở rộng...
Vâng! Cảm ơn bạn!
Mình xét lần lượt từ B4:B5, B4:B6,..., B4:B1203, B5:B6, B5:B7,..., B5:B1203,..., B1202:B1203 trong các cặp tô màu ở cột C và kết quả sẽ gán lần lượt từ trên xuống dưới bắt đầu từ B4, B5, ..., B719403 trong các sheet kết quả! Sau đó lại xét đến cột C so với các vị trí tô màu cột D và kết quả cũng gán lần lượt từ trên xuống dưới bắt đầu từ C4,..., C719403 trong các sheet kết quả.v.v...(Lưu ý: ở sheet2 là kết quả đếm sự xuất hiện ở vị trí tô màu trong cả 2 trường hợp: thuận (dạng AB) và ngược (dạng BA), còn ở sheet3 là kết quả đếm sự xuất hiện chỉ theo 1 trường hợp: thuận (dạng AB), ở sheet4 là kết quả đếm chỉ theo trường hợp: ngược (dạng BA))
 
Lần chỉnh sửa cuối:
Mình cũng có đoạn code cho kết quả thoả mãn ở sheet2 nhưng lại gán kết quả bắt đầu từ B5 (không được như ý muốn lắm vì mình muốn kết quả gán vào bắt đầu từ B4 và tốc độ chạy cũng hơi lâu). Còn yêu cầu kết quả gán vào sheet3, và sheet4 thì chưa hoàn thành! Mình mạn phép xin đưa lên và nhờ GPE giúp đỡ! Biển học là vô bờ, các bạn sẽ có nhiều phương án hay hơn rất nhiều! Chúc GPE một ngày qua thành công!
Function fl(ByVal l As Integer) As Integer
Nhấp chuột vào đây để mở rộng...
Dim TG, Vi_tri_dau As Integer

Vi_tri_dau = 3
If l <= 10 Then
TG = l * 3 + (l - 1) * 2 + Vi_tri_dau + 1
Else
If l <= 20 Then
TG = (l - 10) * 2 + (l - 10 - 1) * 2 + 10 * 3 + 10 * 2 + Vi_tri_dau + 1
Else
If l <= 23 Then
TG = (l - 20) * 1 + (l - 20 - 1) * 2 + 10 * 2 + 10 * 2 + 10 * 3 + 10 * 2 + Vi_tri_dau + 1
Else
TG = (l - 24) * 2 + 3 * 1 + 3 * 2 + 10 * 2 + 10 * 2 + 10 * 3 + 10 * 2 + Vi_tri_dau + 1
End If
End If
End If
fl = TG
End Function
Sub ThucHien()
Dim ij, i, j, count, k, l, h, Ai, Aj, Bi, Bj As Integer
Dim Ma(1203, 1000) As Integer
On Error GoTo err:

For i = 4 To 1203
For j = 1 To 1000
Ma(i, j) = Sheet1.Cells(i, j)
Next
Next
For k = 1 To 999
ij = 4
For i = 4 To 1202
For j = i + 1 To 1203
count = 0
ij = ij + 1
'Ai = Sheet1.Cells(i, k)
'Aj = Sheet1.Cells(j, k)
Ai = Ma(i, k)
Aj = Ma(j, k)
For l = 1 To 27
h = fl(l)
'Bi = Sheet1.Cells(h, k + 1)
'Bj = Sheet1.Cells(h + 1, k + 1)
Bi = Ma(h, k + 1)
Bj = Ma(h + 1, k + 1)
If ((Ai = Bi) And (Aj = Bj)) Or ((Ai = Bj) And (Aj = Bi)) Then count = count + 1
Next
If count > 0 Then
Sheet2.Cells(ij, k + 1) = count
Else
Sheet2.Cells(ij, k + 1) = ""
End If
Next
Next
Next
Exit Sub
err:
MsgBox ij
End Sub
Nhấp chuột vào đây để mở rộng...
 
sep_hatxel đã viết:
Vâng! Cảm ơn bạn!
Mình xét lần lượt từ B4:B5, B4:B6,..., B4:B1203, B5:B6, B5:B7,..., B5:B1203,..., B1202:B1203 trong các cặp tô màu ở cột C và kết quả sẽ gán lần lượt từ trên xuống dưới bắt đầu từ B4, B5, ..., B719403 trong các sheet kết quả! Sau đó lại xét đến cột C so với các vị trí tô màu cột D và kết quả cũng gán lần lượt từ trên xuống dưới bắt đầu từ C4,..., C719403 trong các sheet kết quả.v.v...
Nhấp chuột vào đây để mở rộng...
Vấn đề là bạn xem code trên có ra kq có đúng không.
Tôi dùng code tách những ô tô màu thành ArrCapSo và duyệt qua đém theo ArrCapSo.
Đang nghiên cứu mà chưa hiểu lắm.
Function fl(ByVal l As Integer) As Integer
Nhấp chuột vào đây để mở rộng...
 
ThuNghi đã viết:
Phần 1 phần 2 đã tính tiếp sau. Nếu đếm B4:B5 trong các cặp ô tô màu B4:B5 thì kq gán vào B4 sh2, nếu B4:B6 kq là 5 thì gán vào B?, tương tự B5:B6 thì kq gán vào đâu.
Vậy thì có đếm được thì gán tuần tự vậy.
PHP: 
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long
Dim i As Long, j As Long, k As Long, m As Long, t As Long, s As Long, n As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2()
Dim sCapSo1 As String, sCapSo2 As String
Sub DemCapSo()
fR = 4
With Sheet1
endR = .Cells(65000, 2).End(xlUp).Row
Set MyRng = .Range("B" & fR & ":H" & endR)
Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.Count + 1
If MyRng(iR, 1).Interior.Color <> 16777215 Then
s = s + 1
For k = 1 To 5
ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
Next k
iR = iR + 2
Else
iR = iR + 1
End If
Loop
n = 1: sodong = s
For k = 1 To 2 'k =5
ReDim ArrKQ1(1 To 1000000, 1 To 1)
ReDim ArrKQ2(1 To 1000000, 1 To 1)
s = 0: t = 0
For i = 1 To UBound(Arr, 1) - 1
For j = i + 1 To UBound(Arr, 1)
sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
dem1 = 0: dem2 = 0
For m = 1 To sodong 'so dong cua arrcapso'
If ArrCapSo(m, k) = sCapSo1 Then
dem1 = dem1 + 1
End If
If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
dem2 = dem2 + 1
End If
Next m
If dem1 > 0 Then
s = s + 1
ArrKQ1(s, 1) = dem1
End If
If dem2 > 0 Then
t = t + 1
ArrKQ2(t, 1) = dem2
End If
Next j
Next i
'gan vao
With Sheets(n + 1)
If t > 0 Then
.Range("B4").Resize(t, 1) = ArrKQ2
End If
End With
With Sheets(n + 2)
If s > 0 Then
.Range("B4").Resize(s, 1) = ArrKQ1
End If
End With
n = n + 2
Erase ArrKQ1, ArrKQ2
Next k
Erase ArrCapSo, Arr
Set MyRng = Nothing
End Sub
For k = 1 To 2 'k =5
Do mơi cho chạy k- >2
ie n=1
- Xét B với C => Sheet2, sheet3 - Sheets(n + 1)
- Xét C với D => Sheet4, sheẹt - Sheets(n + 2)
Bạn triển khai tiếp nếu OK.
Nhấp chuột vào đây để mở rộng...

Vâng! Bạn àh, mình đã xem phương án bạn đưa ra! nhưng kết quả ở các sheet thiếu mất trường hợp không có sự xuất hiện? (nếu không xuất hiện thì để ô trống).
- ở đây chỉ cần có 4 sheet: sheet1 là số liệu; sheet2, sheet3, sheet4 là kết quả theo điều kiện.
- xét B với C ở sheet1: nếu xuất hiện hay không xuất hiện(không xuất hiện thì kết quả để trống) đều lần lượt được gán kết quả đếm được vào cột B (từ B4 trở xuống) ở sheet2 (kết quả đếm sự xuất hiện theo cả 2 trường hợp thuận và ngược); gán vào cột B (từ B4)ở sheet3 (kết quả đếm sự xuất hiện chỉ theo trường hợp thuận); gán vào cột B(từ B4) ở sheet4 (kết quả đếm sự xuất hiện chỉ theo trường hợp ngược).
- xét C với D ở sheet1: tương tự sẽ gán kết quả theo điều kiện vào sheet2, sheet3, sheet4 vào cột C (bắt đầu từ C4).
- Xét D với E: gán vào cột D ở các sheet kết quả.
-.v.v...
 
sep_hatxel đã viết:
Vâng! Bạn àh, mình đã xem phương án bạn đưa ra! nhưng kết quả ở các sheet thiếu mất trường hợp không có sự xuất hiện? (nếu không xuất hiện thì để ô trống).
- ở đây chỉ cần có 4 sheet: sheet1 là số liệu; sheet2, sheet3, sheet4 là kết quả theo điều kiện.
- xét B với C ở sheet1: nếu xuất hiện hay không xuất hiện(không xuất hiện thì kết quả để trống) đều lần lượt được gán kết quả đếm được vào cột B (từ B4 trở xuống) ở sheet2 (kết quả đếm sự xuất hiện theo cả 2 trường hợp thuận và ngược); gán vào cột B (từ B4)ở sheet3 (kết quả đếm sự xuất hiện chỉ theo trường hợp thuận); gán vào cột B(từ B4) ở sheet4 (kết quả đếm sự xuất hiện chỉ theo trường hợp ngược).
- xét C với D ở sheet1: tương tự sẽ gán kết quả theo điều kiện vào sheet2, sheet3, sheet4 vào cột C (bắt đầu từ C4).
- Xét D với E: gán vào cột D ở các sheet kết quả.
-.v.v...
Nhấp chuột vào đây để mở rộng...
Ex 2007 chỉ có 1.048.576 dòng mà nếu lấy hết theo B4:B5, ... B4:B1203. => 1200 x 1199 = 1.438.800 dòng
Vậy chỗ nào mà gán.
Code này chỉ so sánh B với C và chỉ gán đến 1.048.576 dòng thôi.
PHP: 
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long
Dim i As Long, j As Long, k As Long, m As Long, t As Long, s As Long, n As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2()
Dim sCapSo1 As String, sCapSo2 As String
Sub DemCapSo2()
fR = 4
With Sheet1
  endR = .Cells(65000, 2).End(xlUp).Row
  Set MyRng = .Range("B" & fR & ":H" & endR)
  Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.count + 1
  If MyRng(iR, 1).Interior.Color <> 16777215 Then
    s = s + 1
    For k = 1 To 5
      ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
    Next k
    iR = iR + 2
  Else
    iR = iR + 1
  End If
Loop
n = 1: sodong = s
For k = 1 To 1 'k =5
  ReDim ArrKQ1(1 To 1048576, 1 To 1)
  ReDim ArrKQ2(1 To 1048576, 1 To 1)
  For i = 1 To UBound(Arr, 1) - 1
    For j = i + 1 To UBound(Arr, 1)
      s = (j - 1) + (i - 1) * UBound(Arr, 1)
      sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
      sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
      'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
      dem1 = 0: dem2 = 0
      For m = 1 To sodong 'so dong cua arrcapso'
        If ArrCapSo(m, k) = sCapSo1 Then
          dem1 = dem1 + 1
        End If
        If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
          dem2 = dem2 + 1
        End If
      Next m
      If s = 1048576 - 4 Then GoTo Exit_Sub
      If dem1 = 0 Then
        ArrKQ1(s, 1) = ""
      Else
        ArrKQ1(s, 1) = dem1
      End If
      If dem2 = 0 Then
        ArrKQ2(s, 1) = ""
      Else
        ArrKQ2(s, 1) = dem2
      End If
    Next j
    'MsgBox s
  Next i
  'gan vao
Exit_Sub:
  If s > 0 Then
    With Sheets(n + 1)
      .Range("B4").Resize(s, 1) = ArrKQ2
    End With
    With Sheets(n + 2)
      .Range("B4").Resize(s, 1) = ArrKQ1
    End With
  End If
  n = n + 2
  Erase ArrKQ1, ArrKQ2
Next k
Erase ArrCapSo, Arr
Set MyRng = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Ex 2007 chỉ có 1.048.576 dòng mà nếu lấy hết theo B4:B5, ... B4:B1203. => 1200 x 1199 = 1.438.800 dòng
Vậy chỗ nào mà gán.
Code này chỉ so sánh B với C và chỉ gán đến 1.048.576 dòng thôi.
Nhấp chuột vào đây để mở rộng...
Hì! Bạn àh! chỉ có: 1199+1198+...+2+1= (1200x1199):2= 719400 dòng thôi!
- Mình đã dùng code bạn đưa ra, nhưng sao lạ thật đúng là hơn 1triệu kết quả liền? Mình đang bị mâu thuẫn? Bạn xem và kiểm tra giúp với nhé!
- Sheet 2 và sheet3 đã có kết quả, còn sheet4 thì chưa có bạn àh?
- Nhưng tốc độ của code thì tuyệt vời! Thích quá! Rất nhanh!
- Cảm ơn bạn rất nhiều!
 
Lần chỉnh sửa cuối:
sep_hatxel đã viết:
Hì! Bạn àh! chỉ có: 1199+1198+...+2+1= (1200x1199):2= 719400 dòng thôi!
- Mình đã dùng code bạn đưa ra, nhưng sao lạ thật đúng là hơn 1triệu kết quả liền? Mình đang bị mâu thuẫn? Bạn xem và kiểm tra giúp với nhé!
- Sheet 2 và sheet3 đã có kết quả, còn sheet4 thì chưa có bạn àh?
- Nhưng tốc độ của code thì tuyệt vời! Thích quá! Rất nhanh!
- Cảm ơn bạn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Hiểu rồi sửa code 1 chút về gán theo dòng s.
Mới làm sh2 và 3 thôi.
Sửa code này nhé.
PHP: 
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long
Dim i As Long, j As Long, k As Long, m As Long, t As Long, s As Long, n As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2()
Dim sCapSo1 As String, sCapSo2 As String
Sub DemCapSo2()
fR = 4
With Sheet1
  endR = .Cells(65000, 2).End(xlUp).Row
  Set MyRng = .Range("B" & fR & ":H" & endR)
  Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.count + 1
  If MyRng(iR, 1).Interior.Color <> 16777215 Then
    s = s + 1
    For k = 1 To 5
      ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
    Next k
    iR = iR + 2
  Else
    iR = iR + 1
  End If
Loop
n = 1: sodong = s
For k = 1 To 1 'k =5'
  ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 1)
  ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 1)
  s = 0
  For i = 1 To UBound(Arr, 1) - 1
    For j = i + 1 To UBound(Arr, 1)
      s = s + 1
      sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
      sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
      'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
      dem1 = 0: dem2 = 0
      For m = 1 To sodong 'so dong cua arrcapso'
        If ArrCapSo(m, k) = sCapSo1 Then
          dem1 = dem1 + 1
        End If
        If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
          dem2 = dem2 + 1
        End If
      Next m
      If dem1 = 0 Then
        ArrKQ1(s, 1) = ""
      Else
        ArrKQ1(s, 1) = dem1
      End If
      If dem2 = 0 Then
        ArrKQ2(s, 1) = ""
      Else
        ArrKQ2(s, 1) = dem2
      End If
    Next j
  Next i
  'gan vao'
  With Sheets(n + 1)
    .Range("B4").Resize(s, 1) = ArrKQ2
  End With
  With Sheets(n + 2)
    .Range("B4").Resize(s, 1) = ArrKQ1
  End With
  n = n + 2
  Erase ArrKQ1, ArrKQ2
Next k
Erase ArrCapSo, Arr
Set MyRng = Nothing
End Sub
 
ThuNghi đã viết:
Hiểu rồi sửa code 1 chút về gán theo dòng s.
Mới làm sh2 và 3 thôi.
Sửa code này nhé.
PHP: 
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long
Dim i As Long, j As Long, k As Long, m As Long, t As Long, s As Long, n As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2()
Dim sCapSo1 As String, sCapSo2 As String
Sub DemCapSo2()
fR = 4
With Sheet1
endR = .Cells(65000, 2).End(xlUp).Row
Set MyRng = .Range("B" & fR & ":H" & endR)
Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.count + 1
If MyRng(iR, 1).Interior.Color <> 16777215 Then
s = s + 1
For k = 1 To 5
ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
Next k
iR = iR + 2
Else
iR = iR + 1
End If
Loop
n = 1: sodong = s
For k = 1 To 1 'k =5'
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 1)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 1)
s = 0
For i = 1 To UBound(Arr, 1) - 1
For j = i + 1 To UBound(Arr, 1)
s = s + 1
sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
dem1 = 0: dem2 = 0
For m = 1 To sodong 'so dong cua arrcapso'
If ArrCapSo(m, k) = sCapSo1 Then
dem1 = dem1 + 1
End If
If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
dem2 = dem2 + 1
End If
Next m
If dem1 = 0 Then
ArrKQ1(s, 1) = ""
Else
ArrKQ1(s, 1) = dem1
End If
If dem2 = 0 Then
ArrKQ2(s, 1) = ""
Else
ArrKQ2(s, 1) = dem2
End If
Next j
Next i
'gan vao'
With Sheets(n + 1)
.Range("B4").Resize(s, 1) = ArrKQ2
End With
With Sheets(n + 2)
.Range("B4").Resize(s, 1) = ArrKQ1
End With
n = n + 2
Erase ArrKQ1, ArrKQ2
Next k
Erase ArrCapSo, Arr
Set MyRng = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Bạn ơi! Đúng rồi! Đúng là như vậy đó! Cảm ơn bạn nhiều quá!
- Tốc độ chạy chỉ mất khoảng 15s cho kiểm tra một cột lại được cả 2 kết quả! Với code cũ của mình thì phải mất gần 1phút mà chỉ có được 1kết quả!
- Cảm ơn bạn nhiều! Chúc Bạn ngày mới thắng lợi! Chúc GPE luôn là người bạn tốt!
- Chờ phần tiếp theo của bạn! Thân ái!
 
Lần chỉnh sửa cuối:
Bạn dùng code sau tính toán 5 cột và tạo KQ ở 3 sh: AB-BA, AB, BA.
Hơi chậm nhé > 1 phút.
PHP: 
Option Explicit
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long, dem3 As Long
Dim i As Long, j As Long, k As Long, m As Long, s As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2(), ArrKQ3()
Dim sCapSo1 As String, sCapSo2 As String
Sub TaoCapSo()
fR = 4
With Sheet1
  endR = .Cells(65000, 2).End(xlUp).Row
  Set MyRng = .Range("B" & fR & ":H" & endR)
  Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.Count + 1
  If MyRng(iR, 1).Interior.Color <> 16777215 Then
    s = s + 1
    For k = 1 To 5
      ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
    Next k
    iR = iR + 2
  Else
    iR = iR + 1
  End If
Loop
Set MyRng = Nothing
End Sub
Sub DemCapSo1()
Dim T
T = Timer
TaoCapSo
sodong = s
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ3(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
For k = 1 To 5
  s = 0
  For i = 1 To UBound(Arr, 1) - 1
    For j = i + 1 To UBound(Arr, 1)
      s = s + 1
      sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
      sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
      'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
      dem1 = 0: dem2 = 0: dem3 = 0
      For m = 1 To sodong 'so dong cua arrcapso'
        If ArrCapSo(m, k) = sCapSo1 Then
          dem1 = dem1 + 1
        End If
        If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
          dem2 = dem2 + 1
        End If
        dem3 = dem2 - dem1
      Next m
      If dem1 = 0 Then 'AB'
        ArrKQ1(s, k) = ""
      Else
        ArrKQ1(s, k) = dem1
      End If
      If dem2 = 0 Then 'AB or BA'
        ArrKQ2(s, k) = ""
      Else
        ArrKQ2(s, k) = dem2
      End If
      If dem3 = 0 Then 'BA'
        ArrKQ3(s, k) = ""
      Else
        ArrKQ3(s, k) = dem3
      End If
    Next j
  Next i
Next k
'gan vao'
With Sheets(2)
  .Range("B4").Resize(s, k - 1) = ArrKQ2
End With
With Sheets(3)
  .Range("B4").Resize(s, k - 1) = ArrKQ1
End With
With Sheets(4)
  .Range("B4").Resize(s, k - 1) = ArrKQ3
End With
Erase ArrKQ1, ArrKQ2, ArrKQ3
Erase ArrCapSo, Arr
MsgBox Timer - T
End Sub
 
ThuNghi đã viết:
Bạn dùng code sau tính toán 5 cột và tạo KQ ở 3 sh: AB-BA, AB, BA.
Hơi chậm nhé > 1 phút.
PHP: 
Option Explicit
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long, dem3 As Long
Dim i As Long, j As Long, k As Long, m As Long, s As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2(), ArrKQ3()
Dim sCapSo1 As String, sCapSo2 As String
Sub TaoCapSo()
fR = 4
With Sheet1
endR = .Cells(65000, 2).End(xlUp).Row
Set MyRng = .Range("B" & fR & ":H" & endR)
Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
iR = 1: s = 0
Do While iR < MyRng.Rows.Count + 1
If MyRng(iR, 1).Interior.Color <> 16777215 Then
s = s + 1
For k = 1 To 5
ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
Next k
iR = iR + 2
Else
iR = iR + 1
End If
Loop
Set MyRng = Nothing
End Sub
Sub DemCapSo1()
Dim T
T = Timer
TaoCapSo
sodong = s
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ3(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
For k = 1 To 5
s = 0
For i = 1 To UBound(Arr, 1) - 1
For j = i + 1 To UBound(Arr, 1)
s = s + 1
sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
dem1 = 0: dem2 = 0: dem3 = 0
For m = 1 To sodong 'so dong cua arrcapso'
If ArrCapSo(m, k) = sCapSo1 Then
dem1 = dem1 + 1
End If
If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
dem2 = dem2 + 1
End If
dem3 = dem2 - dem1
Next m
If dem1 = 0 Then 'AB'
ArrKQ1(s, k) = ""
Else
ArrKQ1(s, k) = dem1
End If
If dem2 = 0 Then 'AB or BA'
ArrKQ2(s, k) = ""
Else
ArrKQ2(s, k) = dem2
End If
If dem3 = 0 Then 'BA'
ArrKQ3(s, k) = ""
Else
ArrKQ3(s, k) = dem3
End If
Next j
Next i
Next k
'gan vao'
With Sheets(2)
.Range("B4").Resize(s, k - 1) = ArrKQ2
End With
With Sheets(3)
.Range("B4").Resize(s, k - 1) = ArrKQ1
End With
With Sheets(4)
.Range("B4").Resize(s, k - 1) = ArrKQ3
End With
Erase ArrKQ1, ArrKQ2, ArrKQ3
Erase ArrCapSo, Arr
MsgBox Timer - T
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều quá, mình không biết nói gì hơn!
Tốc độ như vậy là quá tuyệt rồi bạn àh!
- Nếu mình muốn tăng thêm tính toán cho khoảng 200 cột thì bạn chỉnh hộ mình thông số được không? (mình dự tính cho code chạy trong khoảng thời gian hơn 1h là đạt yêu cầu)
-Chân thành cảm ơn bạn!
 
sep_hatxel đã viết:
Cảm ơn bạn nhiều quá, mình không biết nói gì hơn!
Tốc độ như vậy là quá tuyệt rồi bạn àh!
- Nếu mình muốn tăng thêm tính toán cho khoảng 200 cột thì bạn chỉnh hộ mình thông số được không? (mình dự tính cho code chạy trong khoảng thời gian hơn 1h là đạt yêu cầu)
-Chân thành cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
200 cột hay X cột thì sửa những chỗ sau:
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
Nhấp chuột vào đây để mở rộng...
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ3(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
For k = 1 To 5
Nhấp chuột vào đây để mở rộng...
Thay những số 5 trên. Nhưng nên làm từ từ 10, 20...100, 200.
 
ThuNghi đã viết:
200 cột hay X cột thì sửa những chỗ sau:


Thay những số 5 trên. Nhưng nên làm từ từ 10, 20...100, 200.
Nhấp chuột vào đây để mở rộng...
Vâng! Mình đã thay như bạn hướng dẫn với trường hợp là 10 cột, nhưng thấy báo lỗi và sau đó mình cũng thử bổ xung cả trường hợp:
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 5)
For k = 1 To 5
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
ReDim ArrKQ3(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 5)
For k = 1 To 5

Nhấp chuột vào đây để mở rộng...
nhưng cũng thấy báo cùng một lối: run-time erro "9"
subsclipt out of range.
Option Explicit
Dim endR As Long, iR As Long, fR As Long, sodong As Long, dem1 As Long, dem2 As Long, dem3 As Long
Dim i As Long, j As Long, k As Long, m As Long, s As Long
Dim MyRng As Range, Arr(), ArrCapSo(), ArrKQ1(), ArrKQ2(), ArrKQ3()
Dim sCapSo1 As String, sCapSo2 As String
Sub TaoCapSo()
fR = 4
With Sheet1
endR = .Cells(65000, 2).End(xlUp).Row
Set MyRng = .Range("B" & fR & ":H" & endR)
Arr = MyRng
End With
ReDim ArrCapSo(1 To MyRng.Rows.Count, 1 To 10)
iR = 1: s = 0
Do While iR < MyRng.Rows.Count + 1
If MyRng(iR, 1).Interior.Color <> 16777215 Then
s = s + 1
For k = 1 To 5
ArrCapSo(s, k) = CStr(MyRng(iR, k + 1) & "-" & MyRng(iR + 1, k + 1))
Next k
iR = iR + 2
Else
iR = iR + 1
End If
Loop
Set MyRng = Nothing
End Sub
Sub DemCapSo1()
Dim T
T = Timer
TaoCapSo
sodong = s
ReDim ArrKQ1(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 10)
ReDim ArrKQ2(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 10)
ReDim ArrKQ3(1 To UBound(Arr, 1) * (UBound(Arr, 1) - 1), 1 To 10)
For k = 1 To 10
s = 0
For i = 1 To UBound(Arr, 1) - 1
For j = i + 1 To UBound(Arr, 1)
s = s + 1
sCapSo1 = CStr(Arr(i, k) & "-" & Arr(j, k))
sCapSo2 = CStr(Arr(j, k) & "-" & Arr(i, k))
'Luc nay moi xet dem theo ArrCapSo, chua xet cac cot C...'
dem1 = 0: dem2 = 0: dem3 = 0
For m = 1 To sodong 'so dong cua arrcapso'
If ArrCapSo(m, k) = sCapSo1 Then
dem1 = dem1 + 1
End If
If ArrCapSo(m, k) = sCapSo1 Or ArrCapSo(m, k) = sCapSo2 Then
dem2 = dem2 + 1
End If
dem3 = dem2 - dem1
Next m
If dem1 = 0 Then 'AB'
ArrKQ1(s, k) = ""
Else
ArrKQ1(s, k) = dem1
End If
If dem2 = 0 Then 'AB or BA'
ArrKQ2(s, k) = ""
Else
ArrKQ2(s, k) = dem2
End If
If dem3 = 0 Then 'BA'
ArrKQ3(s, k) = ""
Else
ArrKQ3(s, k) = dem3
End If
Next j
Next i
Next k
'gan vao'
With Sheets(2)
.Range("B4").Resize(s, k - 1) = ArrKQ2
End With
With Sheets(3)
.Range("B4").Resize(s, k - 1) = ArrKQ1
End With
With Sheets(4)
.Range("B4").Resize(s, k - 1) = ArrKQ3
End With
Erase ArrKQ1, ArrKQ2, ArrKQ3
Erase ArrCapSo, Arr
MsgBox Timer - T
End Sub
Nhấp chuột vào đây để mở rộng...
- Mong phản hồi của bạn! Thân! Chúc buổi tối vui vẻ!
 
ThuNghi đã viết:
Sorry, vì chưa test. Xem trong đoạn này thử.
Nhấp chuột vào đây để mở rộng...
Hì! Mình hình như đã hiểu: không biết như thế này có đúng không? Nếu muốn tính toán cho 10 cột thì mình tiến thêm 2 cột nữa thay H thành M, 100 cột thì thay H thành CY,(và thay 5 thành các cột tương ứng) . . . Mình sẽ kiểm tra bằng cách cho chạy 5 cột rồi so với 10 cột có trùng kết quả cuối không?
- Cảm ơn bạn rất nhiều! Bạn nhiệt tình quá! Một lần nữa xin cảm ơn bạn! Cảm ơn GPE! Ngày cũ qua đi Ngày mới tốt lành! Thân ái!
 
sep_hatxel đã viết:
Hì! Mình hình như đã hiểu: không biết như thế này có đúng không? Nếu muốn tính toán cho 10 cột thì mình tiến thêm 2 cột nữa thay H thành M, 100 cột thì thay H thành CY,(và thay 5 thành các cột tương ứng) . . . Mình sẽ kiểm tra bằng cách cho chạy 5 cột rồi so với 10 cột có trùng kết quả cuối không?
- Cảm ơn bạn rất nhiều! Bạn nhiệt tình quá! Một lần nữa xin cảm ơn bạn! Cảm ơn GPE! Ngày cũ qua đi Ngày mới tốt lành! Thân ái!
Nhấp chuột vào đây để mở rộng...
Nếu mà 200 cột thì nên sửa lại code 1 chút. Thay vì ArrKQ lấy hết 200 cột và gán xuống thì mình gán từng cột sau đó lấy tiếp ...
Vì với 5 cột thì gán 1 lần sẽ nhanh hơn. Còn 200 cột thì ArrKQ gồm 800.000 dòng và 200 cột sẽ nặng. Chưa biết có chạy nổi.
Và nếu số cặp xét > 27 thì cũng nên sửa lại code. Còn = 27 thì không sao.
Mình sẽ sửa code 1 chút.
 
ThuNghi đã viết:
Nếu mà 200 cột thì nên sửa lại code 1 chút. Thay vì ArrKQ lấy hết 200 cột và gán xuống thì mình gán từng cột sau đó lấy tiếp ...
Vì với 5 cột thì gán 1 lần sẽ nhanh hơn. Còn 200 cột thì ArrKQ gồm 800.000 dòng và 200 cột sẽ nặng. Chưa biết có chạy nổi.
Và nếu số cặp xét > 27 thì cũng nên sửa lại code. Còn = 27 thì không sao.
Mình sẽ sửa code 1 chút.
Nhấp chuột vào đây để mở rộng...

Hì, may quá! Mình vừa đi làm về đọc tin này của bạn thật vui! Chúc một ngày mới may mắn!
Cảm ơn bạn nhiều! Số cặp chỉ cần xét = 27 thôi bạn àh! Mong tin của bạn!
 
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

D
Phân công và sắp xếp lịch trực
Trả lời
9
Đọc
204
dangg
D
T
  • Question
Tính tồn đầu , tồn cuối , nhập trong kỳ , xuất trong kỳ
Trả lời
11
Đọc
233
thierry henry
T
GPE-Trợ Lý
Đà Nẵng - Đăng ký tham dự sinh nhật GIAIPHAPEXECL lần thứ 18 ngày 05/10/2024
    • Thích
    • Yêu thích
Trả lời
9
Đọc
171
Maika8008
Maika8008
U
VLOOKUP nhiều cột
    • Chấp nhận
Trả lời
5
Đọc
166
DeTong
D
GPE-Trợ Lý
TP.HCM - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 06/10/2024
    • Thích
2
Trả lời
21
Đọc
946
ptm0412
ptm0412
T
Hàm Sumifs nhiều điều kiện bị lỗi value hoặc trả về 0
Trả lời
14
Đọc
215
ptm0412
ptm0412
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
255
Đọc
23K
ngochienbmt
N
C
Công thức gộp 2 cột thành 1 (dữ liệu gộp so le)
Trả lời
10
Đọc
947
nguyenhuyen0805
N
H
  • Question
Lập trình số liệu Nhập-Xuất-Tồn
2
Trả lời
23
Đọc
395
HUONGHCKT
H
A
  • Question
Nhờ tìm lỗi code không delete các dòng theo điều kiện
    • Cười
2
Trả lời
29
Đọc
444
SA_DQ
SA_DQ
Kiều Mạnh
Lấy dữ liệu cổ phiếu từ Website Cafef.vn về Excel
    • Thích
3 4 5
Trả lời
81
Đọc
3K
Kiều Mạnh
Kiều Mạnh
C
Quản lý tồn kho ván gỗ
Trả lời
10
Đọc
2K
tamthanhpytn
T
H
Xin giúp đỡ công thức excel để tính nâng lương định kỳ
Trả lời
17
Đọc
8K
ngoclam081077
N
K
Lọc dữ liệu gần nhất trong cột
Trả lời
4
Đọc
106
Hoàng Tuấn 868
H
Q
  • Question
Nhờ các bác hướng dẫn hàm filter dùm.
Trả lời
7
Đọc
190
quen_tat_ca
Q
anhnghi07
  • Question
Excel có chứa chương trình VBA: Mỗi khi đã tắt vẫn hiện lại ô thông báo yêu cầu điền mật khẩu!
Trả lời
10
Đọc
174
anhnghi07
anhnghi07
Dai Minh Kim
Excel báo lỗi khi Open
Trả lời
1
Đọc
116
PhanTuHuong
PhanTuHuong
A
  • Question
Mong giúp đỡ tối ưu hoá vòng lặp code tự động điền ngày
    • Cười
Trả lời
4
Đọc
137
Hoàng Tuấn 868
H
Linh Mia
Tìm kiếm dữ liệu dựa vào nhiều điều kiện (điều kiện thuộc khoảng, điều kiện cố định)
    • Chấp nhận
Trả lời
6
Đọc
258
Linh Mia
Linh Mia
Maika8008
Cài đặt tiếng Việt để tạo file help dạng .chm với WinCHM
    • Thích
    • Yêu thích
Trả lời
7
Đọc
1K
kojiro
K
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

Back
Top Bottom