Các khách hàng giống nhau thì số hóa đơn Copy lên cùng một dòng

[NHG]

Mình có bài toán này mong các bác giúp đỡ

 

[SA_DQ]

Bạn thử với macro này xem sao?

Option Explicit
Dim lRow As Long

Sub SortFilter()
' Macro recorded 4/1/2008 by Sa_DQ in GPE.COM
 Dim jW As Long
 ReDim MDLieu(1 To 3)
 
 Sheets("DuLieu").Select:
 lRow = Range("B65432").End(xlUp).Row + 1
 Sheets("KQua").Range("A4:H" & lRow).ClearContents
 SortAll Range("A3:J" & lRow)
 For jW = 4 To lRow
    With Cells(jW, 2)
        If MDLieu(1) <> .Value Then
            If jW > 4 Then
                With Sheets("KQua").Range("B" & _
                    Sheets("KQua").Range("B65432").End(xlUp).Row + 1)
                    .Value = MDLieu(1):         .Offset(, 1) = MDLieu(2)
                    .Offset(, 2) = MDLieu(3)
                End With
            End If
            MDLieu(1) = .Value:            MDLieu(2) = .Offset(, 1)
            MDLieu(3) = .Offset(, 2)
        Else
            MDLieu(3) = MDLieu(3) & "; " & .Offset(, 2)
        End If
    End With
    MsgBox MDLieu(3)
 Next jW
 SortAll Range("A3:J" & lRow), False
End Sub

Sub SortAll(Rng As Range, Optional Truoc As Boolean = True)
 Dim RngTT As Range, Rng0 As Range, Rng9 As Range
 
 Set RngTT = Range("A4")
 If Truoc Then
    Set Rng0 = Range("B4"):         Set Rng9 = Range("G4")
 Else
    Set Rng0 = Range("G4"):         Set Rng9 = Range("B4")
 End If
 Range("A3:I17").Select
 Selection.Sort Key1:=Rng0, Order1:=xlAscending, Key2:=RngTT _
    , Order2:=xlAscending, Key3:=Rng9, Order3:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
    xlSortNormal
End Sub

 

[DOSNET]

- Bài của Bác Sa em chạy có lọc được nhưng vẫn báo lỗi, bác check lại nhé !
To NHG : Nếu bạn muốn dùng công thức thì có hàm LOC của Mr Tuấn, cũng hay và phù hợp với bài toán có dữ liệu vừa và nhỏ.

 

[salam]

To NHG : Nếu bạn muốn dùng công thức thì có hàm LOC của Mr Tuấn, cũng hay và phù hợp với bài toán có dữ liệu vừa và nhỏ.

CT lọc của Bác Tuấn chỉ lọc được danh sách thôi còn nhặt số HD lên một dòng theo yêu cầu của bài toán Em thấy khó khó làm sáo ý Bác.

 

[DOSNET]

Uh nhỉ ko nhìn kỹ, phải liệt kê HD thì hơi khoai...tớ đang nghĩ phương án dùng bằng công thức xem có được ko !

 

[NHG]

phamnhukhang có thể nói rõ lỗi ở đâu không?
Mình chạy thấy ổn mà
Thank Sa_DQ nhé
Nhưng Sa_DQ ơi bạn có thể cho mình biết chức năng SortAll để làm gì không

 

[DOSNET]

- Thực ra code chạy tốt nhưng nên bỏ xác nhận gộp HD bằng nút OK, nếu dữ liệu lớn 10.000 HD chẳng hạn...lúc đó chắc ko đủ time và kiên nhẫn đề xác nhận (test trên máy của mình)
- Lỗi thứ hai là code làm thay đổi vị trí data gốc

 

[SA_DQ]

- Thực ra code chạy tốt nhưng . . . .Lỗi thứ hai là code làm thay đổi vị trí data gốc

Câu lệnh cuối là mình dự phòng để trả CSDL vế vị trí ban đầu;
Chỉ có điều mình chưa biết lúc ban đầu CSDL được nhập theo trình tự nào, nên mình đã xếp lại (trong câu lệnh cuối này) theo trường [STT]; Tuy nhiên số TT là do mình tự đặt ra, không trùng í với 1 ai bất kỳ, thông cảm nha!

Nhưng Sa_DQ ơi bạn có thể cho mình biết chức năng SortAll để làm gì không?
--------------------------------------------------------------------------------

Macro này được gọi 2 lần với các đối số thay đổi cho phù hợp:
Lần đầu:
Để gộp các hóa đơn vô 1 dòng thì trước tiên dữ liệu nguồn phải được xếp 1 cách tuần tự theo [MaKH] (có nghĩa là theo tên KH);
Lần sau: Sau cùng thì định trả về CSDL ban đầu

nhưng nên bỏ xác nhận gộp HD bằng nút OK, nếu dữ liệu lớn 10.000 HD chẳng hạn...lúc đó chắc ko đủ time và kiên nhẫn đề xác nhận (test trên máy của mình)

Đúng là câu lệnh MsgBox ". . ." là không cần đối với tác gia topic; Nhưng lúc thử chương trình viết, mình dùng nó để kiểm soát. Sau đó lại quên vô hiệu hóa đi;
Xin cảm ơn nha!

 

[NHG]

 

[nvson]

Thêm một cách nữa cho bạn tham khảo
(Không làm thay đổi cấu trúc sheets("Du_lieu_goc")

Option Explicit
Public rngData As Range
Public subRange As Range
Private Sub Locdulieu1()
    Sheets("Du_lieu_goc").Select
    Columns("C:C").Select
    Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
 
    If Range("C65536").End(xlUp).Row >= 4 Then
        Range("C4:C" & Range("C65536").End(xlUp).Row).Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Set subRange = Selection
    End If
End Sub
 
 
'Chuong trinh CHINH
Public Sub Locdulieu2()
Application.ScreenUpdating = False
Call Locdulieu1
    Dim i, j, cell_i
    Range("A3:I1").Select
    Selection.AutoFilter
 
    For Each cell_i In subRange
        i = i + 1
        Selection.AutoFilter field:=3, Criteria1:=cell_i
        If Range("C65536").End(xlUp).Row >= 4 Then
            Range("A4:I" & Range("C65536").End(xlUp).Row).Select
            Selection.SpecialCells(xlCellTypeVisible).Select
            Set rngData = Selection
 
            For j = 1 To rngData.Rows.Count
                Sheets("Ket_qua").Cells(i + 3, 2) = rngData.Cells(1, 2)
                Sheets("Ket_qua").Cells(i + 3, 3) = rngData.Cells(1, 3)
                If j < 2 Then
                    Sheets("Ket_qua").Cells(i + 3, 4) = rngData.Cells(j, 4)
                Else
                    Sheets("Ket_qua").Cells(i + 3, 4) = Sheets("Ket_qua").Cells(i + 3, 4) & ";" & rngData.Cells(j, 4)
                End If
            Next j
        End If
    Next cell_i
    Selection.AutoFilter
    Sheets("Ket_qua").Select
Application.ScreenUpdating = True
End Sub

 

[SA_DQ]

Option Explicit
Sub CopyTo() 
 Dim Rng As Range, Clls As Range, cRng As Range

 Set Rng = Selection
 For Each Clls In Rng
        If cRng Is Nothing Then
            Set cRng = Clls.EntireRow
        Else
            Set cRng = Union(cRng, Clls.EntireRow)
        End If
 Next Clls
 cRng.Copy Destination:=Sheets("KQua").Range("A9")
End Sub

 

[DOSNET]

Anh Nvson nên lọc theo mã khách hàng thì hay hơn, có thể nhiều hợp đồng trùng tên khách hàng nhưng khác mã. và thêm cột số TT nữa.

 

[nvson]

Anh Nvson nên lọc theo mã khách hàng thì hay hơn, có thể nhiều hợp đồng trùng tên khách hàng nhưng khác mã. và thêm cột số TT nữa.

Bạn chỉ cần thay vài dòng lệnh là OK ngay thôi.

Private Sub Locdulieu1()
    Sheets("Du_lieu_goc").Select
    Columns("[B][COLOR=red]B:B[/COLOR][/B]").Select
    Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
    If Range("B[B][COLOR=red]65536[/COLOR][/B]").End(xlUp).Row >= 4 Then
        Range("[B][COLOR=red]B4:B[/COLOR][/B]" & Range("[B][COLOR=red]B65536[/COLOR][/B]").End(xlUp).Row).Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Set subRange = Selection
    End If
End Sub

Trong macro chính thay đổi dòng lệnh:

Selection.AutoFilter field:=3, Criteria1:=cell_i
If Range("C65536").End(xlUp).Row >= 4 Then

bằng:

Selection.AutoFilter [COLOR=red][B]field:=2[/B][/COLOR], Criteria1:=cell_i
If Range("B65536").End(xlUp).Row >= 4 Then

(Nói chung là thay đổi cột C bằng cột B)

 

[NHG]

Option Explicit
Sub CopyTo() 
 Dim Rng As Range, Clls As Range, cRng As Range
 
 Set Rng = Selection
 For Each Clls In Rng
        If cRng Is Nothing Then
            Set cRng = Clls.EntireRow
        Else
            Set cRng = Union(cRng, Clls.EntireRow)
        End If
 Next Clls
 cRng.Copy Destination:=Sheets("KQua").Range("A9")
End Sub

Code của bạn rất đúng với yêu cầu đề bài đặt ra nhưng bạn có thể giải thích rõ hơn các dòng lệnh không? để trong trường hợp khác mình biết cách áp dụng, ví dụ mình muốn Copy 4 cột, từ B đến D chứ không phải từ A đến D thì mình không biết phải sửa code ở đoạn nào

 

[hoangdanh282vn]

Uh nhỉ ko nhìn kỹ, phải liệt kê HD thì hơi khoai...tớ đang nghĩ phương án dùng bằng công thức xem có được ko !

Dùng công thức vẫn được, có điều phải thêm nhiều cột phụ và nhiều name.
Có bao nhiêu khách hàng thì dùng bấy nhiêu cột phụ và số hóa đơn của 1 khách hàng chính là số name phải đặt, thế thì hơi oải nhỉ.
ta thử dùng hàm mãng xem.
bài toán đặt ra là ghép các phần tử trong một mãng lại với nhau. Cái này hơi khó.
VD : ghép phần tử trong mãng Row(1:5) thành 12345

 

[SA_DQ]

Nhưng bạn có thể giải thích rõ hơn các dòng lệnh không? để trong trường hợp khác mình biết cách áp dụng, ví dụ mình muốn Copy 4 cột, từ B đến D chứ không phải từ A đến D thì mình không biết phải sửa code ở đoạn nào

Cái này phải nói trước:
Code ở trên nó sẽ Copy tất cả các dòng mà có chưa các ô bạn đã chọn; Nhưng vì bạn không có dữ liệu, nên sẽ không thấy chúng làm gì với những ô trắng mà thôi!
Bạn muốn tự nghiêm cứu & phát triển thì đây, xin mời:

Option Explicit

Sub SCopyTo()
 Dim Rng As Range, Clls As Range, cRng As Range
 
1 Set Rng = Selection
2 For Each Clls In Rng
3        If cRng Is Nothing Then
4            Set cRng = Clls.Offset(, -1).Resize(1, 4)
5        Else
6            Set cRng = Union(cRng, Clls.Offset(, -1).Resize(1, 4))
7        End If
8 Next Clls
9 cRng.Copy Destination:=Sheets("KQua").Range("B9")
End Sub

Trước tiên mình khuyên bạn đi từ xa đến gần; Từ xa mình có thể bao quát hết toàn bộ/tổng thể; Sau đó ta vẫn kịp đi vô chi tiết;
Phần tổng thể: Bạn thấy dòng nào đã sửa đổi
(Có phải 4, 6 & 9 (!))
Trong đó 2 câu đầu na ná giống nhau;
Dòng Code cũ tương đương (tw đw) với dòng 4 được diễn dịch là:
Lấy dòng có chưa ô Clls gán vô biến cRng
Với dòng tw đw với dòng 6, được diễn dịch là:
Lấy dòng có chứa ô Clls kết nối vô biến cRng
Bạn có thể tìm các bài của mình trước đây có nói về phương (phw) thức Union(), Intersect()

Với đoạn Code mới thì ta sẽ không Copy cả dòng; mà dòng nào thỏa, ta chỉ lấy 4 ô bắt đầu từ cột 'B';
Điều này được thể hiện ở đâu (?)
Ở phw thức Offset() & phw thức Resize() (Bạn cũng sẽ phải tìm hiểu thêm các phw thức Offset() & Resize() trên diễn đàn càng nhiều càng tốt)
Đoạn Code trên thích ứng với việc bạn đã chọn trước 1 số ô cần chép trên cột 'C' & mở rọng 2 phía trái 'B' & 2 ô bên phải 'D' & 'E'.
Dòng 9 là vị trí chép đến, thế thôi!

 

[anhtuan1066]

Dùng công thức vẫn được, có điều phải thêm nhiều cột phụ và nhiều name.
Có bao nhiêu khách hàng thì dùng bấy nhiêu cột phụ và số hóa đơn của 1 khách hàng chính là số name phải đặt, thế thì hơi oải nhỉ.
ta thử dùng hàm mãng xem.
bài toán đặt ra là ghép các phần tử trong một mãng lại với nhau. Cái này hơi khó.
VD : ghép phần tử trong mãng Row(1:5) thành 12345

He... he... Làm gì đến nổi thế bạn ơi... Dám bảo đảm tôi làm dc bằng công thức đấy.. mà cũng chẳng nhiều cột phụ như bạn nói đâu (đăng nhẩm tính nhiều lắm là 2 cột phụ)
Bài này cùng lắm cũng giống với bài tính tổng con mà tôi từng đưa lên, cách làm là dùng công thức quét từ dưới lên...
Có điều tác giã này ko thích công thức nên tôi ko tham gia giãi pháp
ANH TUẤN

 

[hoangdanh282vn]

He... he... Làm gì đến nổi thế bạn ơi... Dám bảo đảm tôi làm dc bằng công thức đấy.. mà cũng chẳng nhiều cột phụ như bạn nói đâu (đăng nhẩm tính nhiều lắm là 2 cột phụ)
Bài này cùng lắm cũng giống với bài tính tổng con mà tôi từng đưa lên, cách làm là dùng công thức quét từ dưới lên...
Có điều tác giã này ko thích công thức nên tôi ko tham gia giãi pháp
ANH TUẤN

Anhtuan ơi, cho dù tác giả không thích thì vẫn còn rất nhiều người đang mong được xem cách giải đấy. Ở đây không phải là thích hay không mà là làm được bằng những cách nào và giải pháp ra sao? Luôn Ưu tiên cho công thức sử dụng hàm bình thường.( vì đa số các bạn không bít về VBA mà).
- Quét mảng thì mình bít nhưng ghép mảng thì thật là chưa nghĩ ra.
- Àh mà Anhtuan ơi, trong VD của bạn ấy là những hóa đơn của 1 khách hàng nằm liền nhau, chứ trong thực tế, số lần khách hàng xuất hiện cũng như số hóa đơn của khách hàng đó là rất nhiều, nằm rải rác và không phải vài cái như trên VD đâu.
Anh làm thử xem nha.