Giúp viết Code lọc dữ liệu sang sheet khác (1 người xem)

[huyhoang1768]

Chào anh chị Em có file gửi kèm cùng kết quả mong muốn anh chị giúp em viết đoạn code ạ em cảm ơn!

 

[Let'GâuGâu]

Chào anh chị Em có file gửi kèm cùng kết quả mong muốn anh chị giúp em viết đoạn code ạ em cảm ơn!

bạn tham khảo

Dim Nguon As Variant, KQ(), i, j, k As Long

With Sheet1
    Nguon = .[a5].Resize(.[a10000].End(3).Row, 7).Value
End With
ReDim KQ(1 To UBound(Nguon), 1 To 7)

For i = 1 To UBound(Nguon)
    If Nguon(i, 1) = Sheet2.[i3] Then
           k = k + 1
        For j = 1 To 7
            KQ(k, j) = Nguon(i, j)   
        Next j
[COLOR=#ff0000]tong = tong + Nguon(i, 7)[/COLOR]
    End If
Next i

If k Then
With Sheet2
    .Rows("5:1000").Delete
    .[a5].Resize(k, 7).Value = KQ
    .[g10000].End(3).Offset(1).Value = tong
    .[a10000].End(3).Offset(1).Resize(, 6).Merge
    .[a10000].End(3).Offset(1) = " Tong Cong"
      With .[a5].Resize(k + 1, 7)
        .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
           .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
           .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
End With
End If

End Sub

sory, phải đưa cái tổng ra ngoài vòng lặp j

 

[chuot0106]

Chào anh chị Em có file gửi kèm cùng kết quả mong muốn anh chị giúp em viết đoạn code ạ em cảm ơn!

Mở File xem đã đúng ý chưa nhé!

 

[chuot0106]

Muốn Meger thì xem File này:

 

[Quang_Hải]

Tham khảo thêm code này, không dùng vòng lặp có thể nhanh hơn tẹo

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tongtien As String
If Not Intersect(Target, [I3]) Is Nothing Then
    tongtien = [A65536].End(3).Value
    [A4:G10000].Clear
    With Sheet1.[A4].CurrentRegion
        .AutoFilter 1, [I3]
        .SpecialCells(12).Copy [A4]
        .AutoFilter
    End With
    [G65536].End(3).Offset(1) = "=Sum(R5C:R[-1]C)"
    With [A65536].End(3).Offset(1)
        .Resize(, 6).Merge
        .HorizontalAlignment = xlCenter
        .Value = tongtien
        .CurrentRegion.Borders.Value = 1
    End With
End If
End Sub

 

[huyhoang1768]

Em cảm ơn các anh nhiều ạ, em đọc mà vẫn không hiểu nhiều lắm, đây là mình dùng autofilter lọc coppy sang pải không ạ, em thiếu mất cột STT ở đầu, giúp em sửa lại luôn được không ạ

 

[chuot0106]

Em cảm ơn các anh nhiều ạ, em đọc mà vẫn không hiểu nhiều lắm, đây là mình dùng autofilter lọc coppy sang pải không ạ, em thiếu mất cột STT ở đầu, giúp em sửa lại luôn được không ạ

Xem đã đúng ý chưa nhé!

 

[ndu96081631]

Bài này dùng Advanced Filter mới là nhanh nhất, sao không thấy ai viết code theo hướng này nhỉ?
Còn không thì chơi PivotTable, khỏi code gì ráo luôn

 

[huyhoang1768]

Bài này dùng Advanced Filter mới là nhanh nhất, sao không thấy ai viết code theo hướng này nhỉ?
Còn không thì chơi PivotTable, khỏi code gì ráo luôn

Thầy giúp em được không ạ và giải thích giúp em dòng lệnh nào là input, và dòng lệnh nào là output, em tập ghép vào bài của em mà nó không ra

 

[chuot0106]

Thầy giúp em được không ạ và giải thích giúp em dòng lệnh nào là input, và dòng lệnh nào là output, em tập ghép vào bài của em mà nó không ra

Tôi chẳng hiểu bạn ra sao nữa? Nhờ người ta sửa lại code mà không phản hồi gì cả? Ai chẳng biết là ô tô nhanh hơn xe đạp, nhưng lúc vội mà chưa có ô ô thì xe đạp cũng là 1 giải pháp quá tốt cho bạn rồi!

 

[ndu96081631]

Thầy giúp em được không ạ và giải thích giúp em dòng lệnh nào là input, và dòng lệnh nào là output, em tập ghép vào bài của em mà nó không ra

Lấy dữ liệu tại bài 1 (không có STT) và làm bằng Advanced Filter theo hướng đơn giản nhất (không có dòng SUM) thì code sẽ thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$I$3" Then
    [COLOR=#b22222][B]Sheet1.Range("A4:G1000")[/B][/COLOR].AdvancedFilter [B][COLOR=#006400]xlFilterCopy[/COLOR][/B], [B][COLOR=#0000cd]Range("I2:I3")[/COLOR], [COLOR=#ff0000]Range("A4:G4")[/COLOR][/B]
  End If
End Sub

Để code chạy được, bạn làm như sau:
1> Copy cell A4 của Sheet1, paste vào cell I2 của Sheet2 (để làm tiêu đề cho điều kiện lọc)
2> Copy code ở trên, mở cửa sổ VBA, chọn Sheet2 và paste vào khung bên phải
Vậy là xong, ra bảng tính, gõ SOHD vào cell I3 và xem kết quả
---------------------
Giải thích code:
- Màu nâu: Nguồn dữ liệu
- Màu xanh lá: Lọc và copy sang nơi khác
- Màu xanh dương: Điều kiện lọc
- Màu đỏ: Vùng kết quả

 

[Quang_Hải]

Bài này dùng Advanced Filter mới là nhanh nhất, sao không thấy ai viết code theo hướng này nhỉ?
Còn không thì chơi PivotTable, khỏi code gì ráo luôn

AdvancedFilter và AutoFilter là anh em ruột mà anh NDU, èo, nhưng dạo này em đổi hướng qua dùng Auto-nếu yêu cầu lọc không chọn cột- vì không cần phải tạo vùng điều kiện và dòng tiêu đề không cần phải có sẵn

 

[ndu96081631]

AdvancedFilter và AutoFilter là anh em ruột mà anh NDU, èo, nhưng dạo này em đổi hướng qua dùng Auto-nếu yêu cầu lọc không chọn cột- vì không cần phải tạo vùng điều kiện và dòng tiêu đề không cần phải có sẵn

Nhưng Advanced Filter chắc chắn nhanh hơn. Trong trường hợp dữ liệu lớn, dùng AutoFilter + SpecialCells thì chắc chắn sẽ "tiêu đời" ----> Khi ấy dữ liệu bị "phân mảnh" thành nhiều vùng đến mức code không còn nhận biết được và báo lỗi mà ta chẳng biết đó là nguyên nhân gì

dạo này em đổi hướng qua dùng Auto-nếu yêu cầu lọc không chọn cột

Chưa hiểu lắm chỗ màu đỏ này

 

[huyhoang1768]

Tôi chẳng hiểu bạn ra sao nữa? Nhờ người ta sửa lại code mà không phản hồi gì cả? Ai chẳng biết là ô tô nhanh hơn xe đạp, nhưng lúc vội mà chưa có ô ô thì xe đạp cũng là 1 giải pháp quá tốt cho bạn rồi!

Không pải đâu ạ, không pản hồi là vì em chưa hiểu, em đang nghiên cứu, và trong lúc nghiên cứu thì có thể tìm hiểu nhiều giải pháp khác nhau, để mình hiểu sâu hơn vấn đề

 

[Quang_Hải]

Nhưng Advanced Filter chắc chắn nhanh hơn. Trong trường hợp dữ liệu lớn, dùng AutoFilter + SpecialCells thì chắc chắn sẽ "tiêu đời" ----> Khi ấy dữ liệu bị "phân mảnh" thành nhiều vùng đến mức code không còn nhận biết được và báo lỗi mà ta chẳng biết đó là nguyên nhân gì

Chưa hiểu lắm chỗ màu đỏ này

Ý em là điểm hay nhất của AdvancedFilter là lọc theo điều kiện và có thể chọn những cột cần lấy, nhưng so với AutoFilter thì Advanced phải tạo vùng điều kiện, ít nhất là 2 ô, và vùng đích đến phải có tiêu đề giống nhau, sai 1 nét là đi hoang. Trong khi đó Auto thì khỏe hơn chút, chỉ cần 1 ô điều kiện thôi là lọc được rồi. Tuy nhiên cũng tùy theo dữ liệu và yêu cầu của từng bài

 

[Ngoai Thanh]

Thêm một phương án cho bạn, hoàn chỉnh .

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I3]) Is Nothing Then Exit Sub
Me.UsedRange.Resize(, 7).Offset(2).Clear
Sheet1.[A4:h2000].AdvancedFilter 2, [I2:I3], [A4]
Range("B65536").End(xlUp).Offset(1) = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng"
Range("G65536").End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
End Sub

 

[ndu96081631]

và vùng đích đến phải có tiêu đề giống nhau

Vùng đích đến để trống cũng được mà

 

[huyhoang1768]

Lấy dữ liệu tại bài 1 (không có STT) và làm bằng Advanced Filter theo hướng đơn giản nhất (không có dòng SUM) thì code sẽ thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$I$3" Then
    [COLOR=#b22222][B]Sheet1.Range("A4:G1000")[/B][/COLOR].AdvancedFilter [B][COLOR=#006400]xlFilterCopy[/COLOR][/B], [B][COLOR=#0000cd]Range("I2:I3")[/COLOR], [COLOR=#ff0000]Range("A4:G4")[/COLOR][/B]
  End If
End Sub

Để code chạy được, bạn làm như sau:
1> Copy cell A4 của Sheet1, paste vào cell I2 của Sheet2 (để làm tiêu đề cho điều kiện lọc)
2> Copy code ở trên, mở cửa sổ VBA, chọn Sheet2 và paste vào khung bên phải
Vậy là xong, ra bảng tính, gõ SOHD vào cell I3 và xem kết quả
---------------------
Giải thích code:
- Màu nâu: Nguồn dữ liệu
- Màu xanh lá: Lọc và copy sang nơi khác
- Màu xanh dương: Điều kiện lọc
- Màu đỏ: Vùng kết quả

Em coppy vào thì nó báo lỗi dòng

Sheet1.Range("A4:G1000").AdvancedFilter xlFilterCopy, Range("I2:I3"), Range("A4:G4")

 

[ndu96081631]

Em coppy vào thì nó báo lỗi dòng

Sheet1.Range("A4:G1000").AdvancedFilter xlFilterCopy, Range("I2:I3"), Range("A4:G4")

Nhiều nguyên nhân lắm, chẳng hạn file gốc của bạn không có Sheet1, Sheet2...
Nói chung là: Hoặc là bạn tự mò, hoặc là đưa file lên, tránh tốn công người khác

 

[Quang_Hải]

Nhiều nguyên nhân lắm, chẳng hạn file gốc của bạn không có Sheet1, Sheet2...
Nói chung là: Hoặc là bạn tự mò, hoặc là đưa file lên, tránh tốn công người khác

Cũng từ những lý do này mà em dùng Auto, vì nguời dùng hay bị mấy cái lỗi như thay đổi vùng dk, sửa dòng tiêu đề (nếu người dùng bỏ trống thì cũng đở khổ). Khi người dùng khá hơn chút thì tự nhiên họ sẽ đòi tới advanced thôi. Lúc đó có cơ hội viết lại để ôn bài. he he.

 

[ndu96081631]

Cũng từ những lý do này mà em dùng Auto, vì nguời dùng hay bị mấy cái lỗi như thay đổi vùng dk, sửa dòng tiêu đề (nếu người dùng bỏ trống thì cũng đở khổ). Khi người dùng khá hơn chút thì tự nhiên họ sẽ đòi tới advanced thôi. Lúc đó có cơ hội viết lại để ôn bài. he he.

Có 1 cách dễ để học là: Tự mình lọc bằng Advanced Filter (hoặc AutoFilter) đồng thời bật chức năng record macro lên. Nếu kết quả sau lọc là chính xác thì ta cứ việc xem code rồi áp dụng
Trước đây mình toàn học bằng cách này (nhanh nhất)

 

[Let'GâuGâu]

Bài này dùng Advanced Filter mới là nhanh nhất, sao không thấy ai viết code theo hướng này nhỉ?
Còn không thì chơi PivotTable, khỏi code gì ráo luôn

dùng auto filter hay advanced filter thì nó cái dở là nó dính với tốc độ calculate
lâu lắm rồi, tôi có làm một bài, mà trong file của người ta chứa toàn chức mảng.
thành ra mỗi lần mà nó filter thì ngồi đợi nó cả buổi,
nhưng nếu chuyển qua calculate manual thì nó chạy cái vèo
thành ra tôi đoán là mỗi lần mà nó filter thì nó lại calculte

 

[sealand]

Bạn thêm vào ô I2 của sheet2 là "SOHD" rồi bỏ code sau vào vùng Module của sheet2 rồi test.
Mình không chú giải bạn tự tìm hiểu nha

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, Luu As String
If Target.Address = "$I$3" Then
Set Cl = [G65536].End(3)
If Cl.Row > 4 Then
If Cells(Cl.Row, 1).Resize(, 6).Merge Then Cells(Cl.Row, 1).UnMerge
Luu = Cells(Cl.Row, 1).Value
Range([A5], Cl).Clear
End If
Sheet1.Range("A4:G16").AdvancedFilter 2, [I2:I3], [A4:G16], 0
Set Cl = [G65536].End(3).Offset(1)
Cl.Formula = "=SUM(" & Range([G5], Cl.Offset(-1)).Address & ")"
Cl.Offset(, -6) = Luu
Cl.Offset(, -6).Resize(, 6).Merge
set Cl=Nothing
End If
End Sub

 

[Ngoai Thanh]

Hình như sử lý code chưa thành thạo lắm thì phải :

"Em coppy vào thì nó báo lỗi dòng
Sheet1.Range("A4:G1000").AdvancedFilter xlFilterCopy, Range("I2:I3"), Range("A4:G4") "


Bạn xem tập tin đính kèm xem được chưa nhé .

 

[Quang_Hải]

Mình code theo kiểu này thì chạy đâu cũng không thoát.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tongtien As String
If Not Intersect(Target, [I3]) Is Nothing Then
    tongtien = [A65536].End(3).Value
    [I2] = [A4].Value
    [A5:G10000].Clear
    [A4:G4] = Sheet1.[A4:G4].Value
    Sheet1.[A4:G10000].AdvancedFilter 2, [I2:I3], [A4:G4]
    [G65536].End(3).Offset(1) = "=Sum(R5C:R[-1]C)"
    With [A65536].End(3).Offset(1)
        .Resize(, 6).Merge
        .HorizontalAlignment = xlCenter
        .Value = tongtien
        .CurrentRegion.Borders.Value = 1
    End With
    [I2].ClearContents
End If
End Sub

 

[ndu96081631]

Hình như sử lý code chưa thành thạo lắm thì phải :

"Em coppy vào thì nó báo lỗi dòng
Sheet1.Range("A4:G1000").AdvancedFilter xlFilterCopy, Range("I2:I3"), Range("A4:G4") "


Bạn xem tập tin đính kèm xem được chưa nhé .

Có thấy lỗi gì đâu?
Trong file bạn dùng:

Sheet1.[A4:h2000].AdvancedFilter 2, [I2:I3], [A4]

Thử sửa mấy cái [I2:I3] và [A4] Thành Range("I2:I3") và Range("A4:G4") xem

 

[Ngoai Thanh]

Có thấy lỗi gì đâu?
Trong file bạn dùng:

Sheet1.[A4:h2000].AdvancedFilter 2, [I2:I3], [A4]

Thử sửa mấy cái [I2:I3] và [A4] Thành Range("I2:I3") và Range("A4:G4") xem

Không phải nhà em nói code mà hình như bạn ấy không biêt dán code vào đâu, trong sheet, hay trong thisworbook hay ngoài modunle hoặc sử lý địa chỉ mấy các điều kiện trên đó thày . dòng trên là nhà em trích dẫn bài #18 bạn ấy "la" đấy ạ !

 

[huyhoang1768]

Không phải nhà em nói code mà hình như bạn ấy không biêt dán code vào đâu, trong sheet, hay trong thisworbook hay ngoài modunle hoặc sử lý địa chỉ mấy các điều kiện trên đó thày . dòng trên là nhà em trích dẫn bài #18 bạn ấy "la" đấy ạ !

Em dán được rồi, để em nghiên cứu thêm có thắc mắc gì em xin trợ giúp tiếp ạ, em cảm ơn!