Private Sub CommandButton1_Click()
Dim Ws As Worksheet, sArr(), dArr(), i As Long, j As Byte, n As Byte, k As Long, m As Long
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Data" Then
With Ws
sArr = .Range("G10", .[AI65536].End(3)).Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) <> "" Then
k = k + 1
For j = 1 To 4
n = Choose(j, 1, 2, 3, 7)
dArr(k, j) = sArr(i, n)
Next
End If
Next
Sheet1.[B65536].End(3)(2).Resize(k, 4) = dArr
sArr = .Range("AC10", .[AI65536].End(3)).Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) <> "" Then
m = m + 1
For j = 1 To 4
n = Choose(j, 1, 2, 3, 7)
dArr(m, j) = sArr(i, n)
Next
End If
Next
Sheet1.[B65536].End(3)(1).Offset(1, 0).Resize(m, 4) = dArr
End With
End If
Next Ws
End Sub
[TABLE="width: 72"]
[TR]
[TD="width: 72"][COLOR=#0000ff]Private Sub CommandButton1_Click()[/COLOR][/TD]
[/TR]
[TR]
[TD][COLOR=#0000ff] Sheet1.Range("A3:F1000").AdvancedFilter xlFilterCopy, Range("I3:[/COLOR][COLOR=#ff0000]N4[/COLOR][COLOR=#0000ff]"), Range("P4:U4")
End sub[/COLOR][/TD]
[/TR]
[/TABLE]
Sub test()
Dim arr, arrkq
Dim i, j, erow As Long
Dim stk As Long
stk = Sheet5.Range("C4").Value
erow = Sheet1.Range("A65000").Row
arr = Sheet1.Range("A9:H" & erow).Value
ReDim arrkq(1 To 200, 1 To 6)
For i = 1 To UBound(arr)
[COLOR=#ff0000]If arr(i, 6) Like stk & "*" Then[/COLOR]
j = j + 1
arrkq(j, 1) = arr(i, 3)
arrkq(j, 2) = arr(i, 4)
arrkq(j, 3) = arr(i, 5)
arrkq(j, 4) = arr(i, 7)
arrkq(j, 5) = arr(i, 8)
End If
[COLOR=#ff0000] If arr(i, 7) Like stk & "*" Then[/COLOR]
j = j + 1
arrkq(j, 1) = arr(i, 3)
arrkq(j, 2) = arr(i, 4)
arrkq(j, 3) = arr(i, 5)
arrkq(j, 4) = arr(i, 6)
arrkq(j, 6) = arr(i, 8)
End If
Next i
[COLOR=#ff0000]If j > 0 Then[/COLOR] Sheet5.Range("A11").Resize(j, 6) = arrkq
Exit Sub: Erase arr(), arrkq()
End Sub
Code trên có các biến được khai báo: Dim endR&, fD&, eD&, i&, s&, k&
Nói như vậy mà không hiểu thì hiểu sao được code trời! Viết bài đừng có dùng những ngôn từ chat vào đây nhé! Nhiều người rất dị ứng!Theo e hiểu thì i,s là hàng, k là cột mà tại sao lại là 1 to 4E ko hiểu k đóng vai trò j trong bài này e mới hỏi mà
Hi các anh chị
Sub LocDuyNhat()
Dim nguon(), KQ(1 To 65536, 1 To 2), i As Long, k As Long
With ActiveSheet
nguon = .Range(.[C4], .[C65536].End(3)).Resize(, 2).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(nguon, 1)
If Not .exists(nguon(i, 1)) Then
.Add nguon(i, 1), ""
If nguon(i, 2) <> "" Then
k = k + 1
KQ(k, 1) = nguon(i, 1)
KQ(k, 2) = nguon(i, 2)
End If
End If
Next i
End With
[G4:H65536].ClearContents
[G4].Resize(k, 2) = KQ
End With
End SubSub LocDuyNhat()
Dim LastRow As Long
LastRow = Range("C65536").End(3)
If LastRow < 4 Then Exit Sub
Dim Nguon(), KQ(1 To 65536, 1 To 2), i As Long, k As Long
Nguon = Range("C4:D" & LastRow)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(Nguon, 1)
If Not .Exists(Nguon(i, 1)) Then
.Add Nguon(i, 1), ""
If Nguon(i, 2) <> "" Then
k = k + 1
KQ(k, 1) = Nguon(i, 1)
KQ(k, 2) = Nguon(i, 2)
End If
End If
Next i
End With
Range("G4:H65536").ClearContents
Range("G4").Resize(k, 2) = KQ
End SubNếu là tôi viết thì tôi làm vầy:
Sub LocDuyNhat1()
Dim nguon(), KQ(1 To 65536, 1 To 2), i As Long, k As Long
[COLOR=#ff0000]Dim tmp1 As String, tmp2 As String[/COLOR]
[COLOR=#ff0000]nguon = ActiveSheet.Range("C4:D10000").Value[/COLOR][COLOR=#006400] ''<--- Khai báo vùng dữ liệu thật to, khỏi End(xlUp) gì ráo[/COLOR]
With CreateObject("scripting.dictionary")
For i = 1 To UBound(nguon, 1)
[COLOR=#ff0000]tmp1 = CStr(nguon(i, 1))
tmp2 = CStr(nguon(i, 2))[/COLOR]
[COLOR=#ff0000]If Len(tmp1) Then [/COLOR][COLOR=#006400]''<--- Nếu cột 1 khác rổng thì đi tiếp[/COLOR][COLOR=#ff0000]
If Len(tmp2) Then[/COLOR][COLOR=#ff0000] [/COLOR][COLOR=#006400]''<--- Nếu cột 2 khác rổng thì đi tiếp[/COLOR]
If Not .Exists(tmp1) Then
.Add tmp1, ""
k = k + 1
KQ(k, 1) = tmp1
KQ(k, 2) = tmp2
End If
End If
End If
Next i
End With
[G4:H65536].ClearContents
[COLOR=#ff0000] If k Then[/COLOR] [G4].Resize(k, 2) = KQ [COLOR=#006400]''<--- Nếu không lọc ra được gì thì... nghỉ khỏe[/COLOR]
End SubTác giả muốn thử xem, nếu không có dữ liệu thì code sẽ làm gì, nếu "chơi" một đống hàng như thế, phải chăng là dù có, dù không dữ liệu thì code vẫn hoạt động, đồng thời, vòng lặp vẫn chạy 10 ngàn lần hay không? Tại sao không ngăn chặn ngay từ đầu vấn đề này khi dữ liệu không có? Khi dữ liệu ít thì code chạy ít đi?
Sub LocDuyNhat()
Dim LastRow As Long, MaxRow As Long
[COLOR=#0000ff] ''Tinh so hang lon nhat:[/COLOR]
MaxRow = Rows.Count
With ActiveSheet [COLOR=#0000ff]''<-- Co the thay bang ten sheet khac[/COLOR]
[COLOR=#0000ff] ''Loai bo AutoFilter:[/COLOR]
.AutoFilterMode = False
[COLOR=#0000ff] ''Tim hang cuoi:[/COLOR]
LastRow = .Range("C" & MaxRow).End(xlUp)
[COLOR=#ff0000] ''Neu hang cuoi nho hon hang tieu de thi thoat[/COLOR]
If LastRow < 4 Then Exit Sub
Dim Nguon, KQ
Dim i As Long, k As Long
Dim Tmp1 As String, Tmp2 As String
Nguon = .Range("C4:D" & LastRow)
ReDim KQ(1 To MaxRow, 1 To 2)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(Nguon)
Tmp1 = CStr(Nguon(i, 1))
Tmp2 = CStr(Nguon(i, 2))
[COLOR=#0000ff] ''Ca 2 phai khac rong moi chap nhan:[/COLOR]
If Tmp1 > "" And Tmp1 > "" Then
If Not .Exists(Tmp1) Then
.Add Tmp1, Empty
k = k + 1
KQ(k, 1) = Tmp1
KQ(k, 2) = Tmp2
End If
End If
Next i
End With
.Range("G4:H" & MaxRow).ClearContents
If k Then .Range("G4").Resize(k, 2) = KQ
End With
End SubGiỡn chơi hoài Thầy, 10k dòng và nếu với vài chục cột mà chuyển thành mảng cũng khá mất thời gian đó, thêm việc chạy vòng lặp nữa thì cũng ngốn bộ nhớ tạm hơi nhiều đó chứ! Sau đó trước khi End Sub, một lần nữa nó giải phóng cái biến mảng đó cũng ngốn đi một khoảng thời gian nữa. Theo em thì nên tỉ mỉ một chút vẫn thấy bộ nhớ nó "thong thả" hơn.
Ngộ hen! 10000 lần lập thì là 10000 lần thôi, liên quan gì đến số cột nhỉ? 100 cột hay 1 cột mà tôi muốn nó 10000 lần lập thì nó cũng chỉ chạy 10000 lần thôi, có vấn đề gì chứ?
