Tìm kết quả có điều kiện trong excel2007 (7 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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

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

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

hado83
Cách khôi phục file excel is Corrupt. (1 người xem)
Trả lời
0
Đọc
25
hado83
hado83
Y
Lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp hàng dọc (1 người xem)
Trả lời
2
Đọc
51
Duy Tùng 9x
Duy Tùng 9x
L
Phân rã bảng dự liệu về dạng data (1 người xem)
Trả lời
8
Đọc
146
Duy Tùng 9x
Duy Tùng 9x
T
Tạo add-in zoom ảnh (1 người xem)
Trả lời
2
Đọc
579
HUONGHCKT
H
Momominh
Hỏi công thức tính tổng
Trả lời
9
Đọc
173
lamvankhoat1
L
Anhhe
Em xin nhờ các cao nhân chỉ giáo em cách tính giờ làm việc của nhân viên với ạ Plz
Trả lời
12
Đọc
451
DeTong
D
X
Nhờ anh chị gỡ rối giúp em công thức tính tổng này ạ (4 người xem)
Trả lời
9
Đọc
113
Xuanphuong.ntvn
X
Tuấn Bụng Bự
Không copy/move được sheet trong excel
Trả lời
1
Đọc
88
Hoàng Tuấn 868
H
Emyeuexcel
Tham chiếu nhều điều kiện với khoản thời gian
Trả lời
10
Đọc
212
lamvankhoat1
L
H
Tra cứu mã ngành theo hóa đơn
Trả lời
8
Đọc
230
Hoale85
H
minhminh27
Reply lại email đã gửi (1 người xem)
Trả lời
2
Đọc
555
minhminh27
minhminh27
Phonglinh0902
Hỗ trợ so sánh dữ liệu cột A và B điền kết quả cột C
Trả lời
2
Đọc
108
Phonglinh0902
Phonglinh0902
P
Bóc dự toán nhà dân
Trả lời
6
Đọc
141
thuytrangbp28
T
K
Xử lý (tắt) đường link địa chỉ ô trong excel khi đăng nhập tài khoản MS.
Trả lời
5
Đọc
193
Mr.hieudoanxd
Mr.hieudoanxd
Nguyễn Duy Tuân
Dùng AI trên Excel bằng hàm BS_AI, BS_AI_CHAT của Add-in A-Tools v10
    • Thích
    • Yêu thích
Trả lời
4
Đọc
398
Nguyễn Duy Tuân
Nguyễn Duy Tuân
N
  • Question Question
Xin giúp đỡ in phiếu thông tin hàng loạt có điều kiện
2
Trả lời
28
Đọc
879
HUONGHCKT
H
H
Cách tính số giờ làm thêm vượt quá 300 giờ của người lao động
Trả lời
9
Đọc
233
Hoa minh27
H
L
lọc số "hợp đồng" trong chuỗi câu "diễn giải"
    • Cảm ơn
Trả lời
12
Đọc
376
Duy Tùng 9x
Duy Tùng 9x
Gà Công Nghệ
Làm sao biết email gửi đi thành công và thời gian người nhận email đã xem email của mình? (1 người xem)
Trả lời
9
Đọc
4K
ptm0412
ptm0412
X
  • Question Question
Giúp điều chỉnh thông số công suất máy tự động theo tuần
Trả lời
0
Đọc
87
xsmarthome
X
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom