Lọc và tổng hợp số liệu từ nhiều sheet có cấu trúc khác nhau !!! (1 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)
H

hackeridc

Thành viên mới
Tham gia
21/11/12
Bài viết
24
Được thích
1
Em có một file excel quản lý bán hàng trong đó có các sheet: Report1, Report2, Report3, Check_Name & Check_Time (như file đính kèm).
Cấu trúc của 3 sheet Report1, Report2 và Report3 hơi khác nhau (Đặc thù công việc em phải làm vậy)

Bài toán đặt ra là khi em muốn thực hiện kiểm tra một đơn hàng đã xuất thì:

1. Ở sheet Check_Name: Ghõ tên một cty bất kỳ nào đó vào trong 1 cell (cho phép gõ gần đúng - VD: ở cell D6 thay vì ghõ Tổng cty XNK thì chỉ cần gõ XNK) rồi ấn phím DUYỆT. Khi đó sẽ tự động tìm ở các sheet Report1, Report2, Report3 nếu đúng tên cty đó (XNK) thì cho ra danh sách được sắp xếp ở phía dưới. Tương tự như thế khi thực hiện với tên cty khác và lúc này danh sách mới sẽ ghi đè nên danh sách cũ của cty trước.

2. Tương tự với sheet Check_Time: Tìm theo Ngày xuất đơn hàng.

Rất mong các thầy giải giúp em bài toán này (yêu cầu cụ thể em cũng có ghi trong file).

Trân trọng cam ơn!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bàn toán có vẻ khoai đấy nhưng với 4zum này thì bạn cứ yên tâm sẽ có các cao thủ giải tốt.
 
Upvote 0
Mình mới tập trung số liệu cho bạn mà thôi

Fần định dạng trộn ô mình vốn không ưa; & việc này bạn hãy tự làm bằng tay đi vậy
 
Lần chỉnh sửa cuối:
Upvote 0
SA_DQ đã viết:
Fần định dạng trộn ô mình vốn không ưa; & việc này bạn hãy tự làm bằng tay đi vậy
Nhấp chuột vào đây để mở rộng...

Cảm ơn bác đã giúp em giải quyết được phần nào của bài toán. Phiền bác xử lý thêm giúp em:

1. Vì danh sách khách hàng rất nhiều và sẽ ngày càng ra tăng nên em muốn tìm đơn hàng theo tên gợi nhớ hoặc theo số phiếu bằng cách gõ và ấn nút DUYỆT như em đã trình bày!!!

2. Khác phục lỗi: Nếu các đơn hàng ở sheet Report1 hoặc Report2 hoặc Report3 mà không nối tiếp nhau (VD: ở dòng 3 có đơn hàng, đến dòng 4 không có đơn hàng, khi sang dòng 5 lại có đơn hàng) thì việc tìm ở sheet Check_Name sẽ cho kết quả không đầy đủ (thiếu hẳn các đơn hàng từ dòng 4 trở xuống).

3. Sửa cột Thứ Tự ở sheet Check_Name: Là thứ tự lần lượt của mỗi một đơn hàng được tìm thấy chứ không phải là thứ tự của đơn hàng đó ở các sheet Report1, 2, hoặc 3.

4. Sửa cột Số Phiếu ở sheet Check_Name: Sắp xếp số phiếu của các đơn hàng theo giá trị tăng dần.

5. Nếu trong đơn hàng của một số phiếu nào đó có nhiều hơn 3 mặt hàng thì chỉ hiển thị 1 lần số phiếu cũng như tên công ty và địa chỉ của đơn hàng đó, còn các mặt hàng vẫn hiển thị như cũ lần lượt theo dòng từ trên xuống dưới.

Rất mong nhận được sự giúp đỡ nhiệt tình của bác SA_QD và của các thầy!
 
Upvote 0
Xong rồi đây, bạn kiểm thử đi nha

--=0--=0--=0 }}}}} }}}}} --=0 --=0 --=0
 

File đính kèm

Upvote 0
ChanhTQ@ đã viết:
--=0--=0--=0 }}}}} }}}}} --=0 --=0 --=0
Nhấp chuột vào đây để mở rộng...

Cảm ơn bác ChanhTQ@, mới chỉ gần hợp ý em %#^#$, bác có thể khác phục giúp:

1. Thay vì tạo sẵn một Data Validation lựa chọn tìm kiếm thì đổi thành tạo một ô để gõ từ khóa rồi ấn vào nút bấm DUYỆT tìm để việc tìm được đa dạng và chuyên nghiệp?

2. Tên công ty vẫn hiển thị làm 2 hoặc 3 dòng nếu như trong số phiếu nào đó có 2 hoặc 3 mặt hàng. Chỉ cho hiển thị 1 lần tên công ty giống như địa chỉ và điện thoại mà bác đã làm!!!

Em có gừi file chú thích đính kèm để bác tiện xử lý giúp. Tran trong cảm ơn!
 

File đính kèm

Upvote 0
Cảm ơn bác, mới chỉ gần hợp ý em %#^#$, bác có thể khác phục giúp:

1. Thay vì tạo sẵn một Data Validation lựa chọn tìm kiếm thì đổi thành tạo một ô để gõ từ khóa rồi ấn vào nút bấm DUYỆT tìm để việc tìm được đa dạng và chuyên nghiệp?

2. Tên công ty vẫn hiển thị làm 2 hoặc 3 dòng nếu như trong số phiếu nào đó có 2 hoặc 3 mặt hàng. Chỉ cho hiển thị 1 lần tên công ty giống như địa chỉ và điện thoại mà bác đã làm!!!

Em có gừi file chú thích đính kèm để bác tiện xử lý giúp. Tran trong cảm ơn!
Nhấp chuột vào đây để mở rộng...

(1) Để hợp với í bạn hoàn toàn thì bạn tìm trên diễn đàn & thực hiện tiếp đi;
Í của bạn là chạy macro từ nút lệnh; Còn trong file là chạy macro từ sự kiện thay dữ liệu trong 1 ô
Mình cảm giác rằng đã đến lúc bạn fải tự mình làm ra những gì để thực hiện ước nguyện của mình rồi đó.
Chuyện này có trên diễn đàn & bạn bỏ thời gian tìm hiểu vài ngày xem sao!

Mình cũng nói thêm là các trang Report(i) mà để dòng trống trong số liệu là không hợp khẩu vị với VBA lắm đâu!

(2) Bạn nghiên cứu & thử sửa các con số 2 lần lượt trong macro trong bài xem sao

PHP: 
Option Explicit
Public TT As Byte, Rg0 As Range
Sub GPE(Optional Col2 As Byte = 15, Optional Col As Byte = 6, Optional Offs As Byte = 9, Optional Tr As Byte = 8)
With [B999].End(xlUp).Offset(1)
    .Resize(, Tr).Value = Rg0.Value                      '<=|'
    .Offset(, 8).Resize(, Col).Value = Rg0(Offs).Resize(, Col).Value
    If Tr = 8 Then _
        .Offset(, 18).Resize(, 2).Value = Rg0(Col2).Resize(, 2).Value
    TT = TT + 1:        .Offset(, -1).Value = TT
 End With
End Sub

(Thay vì cung cấp trị 2 cho tham biến 'Tr' mỗi khi ta gọi macro này, ta cung cấp là 1 xem sao)
 
Upvote 0
HYen17 đã viết:
(1) Để hợp với í bạn hoàn toàn thì bạn tìm trên diễn đàn & thực hiện tiếp đi;
Í của bạn là chạy macro từ nút lệnh; Còn trong file là chạy macro từ sự kiện thay dữ liệu trong 1 ô
Mình cảm giác rằng đã đến lúc bạn fải tự mình làm ra những gì để thực hiện ước nguyện của mình rồi đó.
Chuyện này có trên diễn đàn & bạn bỏ thời gian tìm hiểu vài ngày xem sao!

Mình cũng nói thêm là các trang Report(i) mà để dòng trống trong số liệu là không hợp khẩu vị với VBA lắm đâu!

(2) Bạn nghiên cứu & thử sửa các con số 2 lần lượt trong macro trong bài xem sao

PHP: 
Option Explicit
Public TT As Byte, Rg0 As Range
Sub GPE(Optional Col2 As Byte = 15, Optional Col As Byte = 6, Optional Offs As Byte = 9, Optional Tr As Byte = 8)
With [B999].End(xlUp).Offset(1)
    .Resize(, Tr).Value = Rg0.Value                      '<=|'
    .Offset(, 8).Resize(, Col).Value = Rg0(Offs).Resize(, Col).Value
    If Tr = 8 Then _
        .Offset(, 18).Resize(, 2).Value = Rg0(Col2).Resize(, 2).Value
    TT = TT + 1:        .Offset(, -1).Value = TT
 End With
End Sub

(Thay vì cung cấp trị 2 cho tham biến 'Tr' mỗi khi ta gọi macro này, ta cung cấp là 1 xem sao)
Nhấp chuột vào đây để mở rộng...

Hi bác HYen17,
Trước hết phải cảm ơn bạn đã cùng tham gia giải bài toán này giúp em.
Em cũng đã dành rất nhiều thời gian để thinking nhưng vì mới bập bẹ nên đành phải nhờ các bác và các thầy giúp đỡ. Vẫn biết những gì mình tự làm ra chẳng có ý nghĩa không lớn thì nhỏ.
Nếu được thì nhờ cậy bác xử lý giúp %#^#$.
Trân trọng!
 
Upvote 0
Bạn copy macro này đè lên cái tương ứng trong file; Sau đó tự làm cái còn lại

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 If Not Intersect(Target, [D7]) Is Nothing Then
    Rw = [B9].CurrentRegion.Rows.Count
    [A11].Resize(Rw, 22).Clear:                 TT = 0
    For J = 1 To 3
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -1).Resize(, J * 10 + 13)
                If J = 1 Then
                    GPE
                ElseIf J = 2 Then
                    GPE 25
                    GPE 25, 8, 17, 1            '2'
                ElseIf J = 3 Then
                    GPE 39
                    GPE 39, 10, 19, 1           '2'
                    GPE 39, 10, 29, 1           '2'
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B9].CurrentRegion.Rows.Count
    Set Rng = [B11].Resize(Rw, 22)
    Rng.Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 End If
End Sub
 
Upvote 0
HYen17 đã viết:
PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 If Not Intersect(Target, [D7]) Is Nothing Then
    Rw = [B9].CurrentRegion.Rows.Count
    [A11].Resize(Rw, 22).Clear:                 TT = 0
    For J = 1 To 3
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -1).Resize(, J * 10 + 13)
                If J = 1 Then
                    GPE
                ElseIf J = 2 Then
                    GPE 25
                    GPE 25, 8, 17, 1            '2'
                ElseIf J = 3 Then
                    GPE 39
                    GPE 39, 10, 19, 1           '2'
                    GPE 39, 10, 29, 1           '2'
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B9].CurrentRegion.Rows.Count
    Set Rng = [B11].Resize(Rw, 22)
    Rng.Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 End If
End Sub
Nhấp chuột vào đây để mở rộng...

Dear HYen17,
Phiền bác giải thích giúp em đoạn giải pháp này để em học tập và mở mang tầm mắt với.
Thú thực mấy vụ code chắc em phải dành nhiều thời gian may ra mới bập bẹ được.:.,
Cảm ơn bác HYen17 rất nhiều!
 
Upvote 0
Theo mình, đầu tiên bạn cần thấu đáo macro này cái đã:

PHP: 
Option Explicit
1 Public TT As Byte, Rg0 As Range
Sub GPE(Optional Col2 As Byte = 15, Optional Col As Byte = 6, Optional Offs As Byte = 9, Optional Tr As Byte = 8)
3 With [B999].End(xlUp).Offset(1)
    .Resize(, Tr).Value = Rg0.Value                      '<=|'
5    .Offset(, 8).Resize(, Col).Value = Rg0(Offs).Resize(, Col).Value
6    If Tr = 8 Then _
        .Offset(, 18).Resize(, 2).Value = Rg0(Col2).Resize(, 2).Value
8    TT = TT + 1:        .Offset(, -1).Value = TT
9 End With
End Sub

Macro này đang ở module 1
D1: Khai báo biến dùng toàn cục TT & Rg0; Biến này có thể xài chung với nhiều macro khác trong các trang tính;
D2: Tên của macro & sau nó là 4 tham bêến tùy chọn;
Các tham biến này đếu được ứng trước các trị cần có; Một khi ta không cung cấp 1 tham biến nào thì nó lấy giá trị mặc định này gán vô cho tham biến ấy
D3: Tuyên bố làm việc với ô trống đầu tiên (không chứa dữ liệu) thuộc cột
D4: Ô ta đã tuyên cáo mở rọng về fía fải Tr ô sẽ nhận các giá trị từ vùng Rg0
Nếu ta không cung cấp Tr khi gọi macro, nó sẽ mở rọng 8 ô để được nhập dữ liệu; Nếu ta cung cấp cho Tr trị là 1 thì chì 1 ô được nhập trị từ ô đầu tiên của Rg0
Rg0 như nói ban đầu là biến toàn cục, nên nó đã được ấn định trong macro cha/mẹ khi gọi macro con này;
(Nếu ta không gán vùng ô cho tham biến này, VBE sẽ báo lỗi tại dòng lệnh này)

Để hiểu rõ dòng lệnh 5, mình xin tách ra 2 fần (giống như 2 mệnh đề trong 1 câu)
Đó là Rg0(Offs).Resize( ,Col).Value
Offs là 1 tham biến nếu ta cung cấp trị sẽ nhận trị đó, nếu ta không cung cấp thì tại D2 ta sẽ thấy nó bằng 9
Rg0(9) là ô thứ 9 của vùng Rg0;
Resize( ,Col) (Col là tham biến ta cần cung cấp trị; Nếu không làm chuyện này, VBE sẽ lấy trị là 6
Toàn bộ mệnh đề này có nghĩa là: Dữ liệu thuộc vùng ô kể từ ô thứ Offs của Rg0 mở rọng về fía fải Col ô
Mệnh đế đầu của câu lệnh là: Kể từ ô ta đang tuyên bố làm việc, dịch về fải 8 ô & mở rọng (cũng) vế fía fải Col ô được gán trị của vùng do mệnh đề sau ta đã fân tích
D6 (nối tiếp với dòng 7 thành 1 câu lệnh)

Điều kiện nếu Tr =8 ( = với mặc định; Nghĩa là ta không cung cấp tham trị) thì macro sẽ làm cái việc như sau:

Cách vế fía fải 18 ô, mở rọng thêm 1 ô sẽ được gán trị bỡi vùng (2) ô từ ô cách ô đầu của Rg0 Col2 ô
D7 gốm 2 câu lệnh íiết chung;
Câu đầu là: Tăng cho biến toàn cục TT lên 1 đơn vị;
Câu sau là: Ô trái liền kề vớ mô ta tuyên cáo làm việc được gán trị từ biện TT
D9: Kết thúc/Hết tuyên cáo

Chờ fát biểu từ bạn cái đã, nhỉ!
 
Upvote 0
Anh ChanhTQ@ ơi, anh giải thích luôn những dòng lệnh trong sheet Check_Name (& sheet Check_Time) luôn đi, càng tường tận càng tốt anh nhé %#^#$:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim J As Byte, Rw As Long
Dim fAdd As String
If Not Intersect(Target, [D7]) Is Nothing Then
Rw = [B9].CurrentRegion.Rows.Count
[A11].Resize(Rw, 22).Clear: TT = 0
For J = 1 To 3
Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
Set Rng = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
If Not sRng Is Nothing Then
fAdd = sRng.Address
Do
Set Rg0 = sRng.Offset(, -1).Resize(, J * 10 + 13)
If J = 1 Then
GPE
ElseIf J = 2 Then
GPE 25
GPE 25, 8, 17, 2
ElseIf J = 3 Then
GPE 39
GPE 39, 10, 19, 2
GPE 39, 10, 29, 2
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> fAdd
End If
Next J
Rw = [B9].CurrentRegion.Rows.Count
Set Rng = [B11].Resize(Rw, 22)
Rng.Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End Sub
 
Upvote 0
ChanhTQ@ đã viết:
PHP: 
Option Explicit
1 Public TT As Byte, Rg0 As Range
Sub GPE(Optional Col2 As Byte = 15, Optional Col As Byte = 6, Optional Offs As Byte = 9, Optional Tr As Byte = 8)
3 With [B999].End(xlUp).Offset(1)
    .Resize(, Tr).Value = Rg0.Value                      '<=|'
5    .Offset(, 8).Resize(, Col).Value = Rg0(Offs).Resize(, Col).Value
6    If Tr = 8 Then _
        .Offset(, 18).Resize(, 2).Value = Rg0(Col2).Resize(, 2).Value
8    TT = TT + 1:        .Offset(, -1).Value = TT
9 End With
End Sub

Macro này đang ở module 1
D1: Khai báo biến dùng toàn cục TT & Rg0; Biến này có thể xài chung với nhiều macro khác trong các trang tính;
D2: Tên của macro & sau nó là 4 tham bêến tùy chọn;
Các tham biến này đếu được ứng trước các trị cần có; Một khi ta không cung cấp 1 tham biến nào thì nó lấy giá trị mặc định này gán vô cho tham biến ấy
D3: Tuyên bố làm việc với ô trống đầu tiên (không chứa dữ liệu) thuộc cột
D4: Ô ta đã tuyên cáo mở rọng về fía fải Tr ô sẽ nhận các giá trị từ vùng Rg0
Nếu ta không cung cấp Tr khi gọi macro, nó sẽ mở rọng 8 ô để được nhập dữ liệu; Nếu ta cung cấp cho Tr trị là 1 thì chì 1 ô được nhập trị từ ô đầu tiên của Rg0
Rg0 như nói ban đầu là biến toàn cục, nên nó đã được ấn định trong macro cha/mẹ khi gọi macro con này;
(Nếu ta không gán vùng ô cho tham biến này, VBE sẽ báo lỗi tại dòng lệnh này)

Để hiểu rõ dòng lệnh 5, mình xin tách ra 2 fần (giống như 2 mệnh đề trong 1 câu)
Đó là Rg0(Offs).Resize( ,Col).Value
Offs là 1 tham biến nếu ta cung cấp trị sẽ nhận trị đó, nếu ta không cung cấp thì tại D2 ta sẽ thấy nó bằng 9
Rg0(9) là ô thứ 9 của vùng Rg0;
Resize( ,Col) (Col là tham biến ta cần cung cấp trị; Nếu không làm chuyện này, VBE sẽ lấy trị là 6
Toàn bộ mệnh đề này có nghĩa là: Dữ liệu thuộc vùng ô kể từ ô thứ Offs của Rg0 mở rọng về fía fải Col ô
Mệnh đế đầu của câu lệnh là: Kể từ ô ta đang tuyên bố làm việc, dịch về fải 8 ô & mở rọng (cũng) vế fía fải Col ô được gán trị của vùng do mệnh đề sau ta đã fân tích
D6 (nối tiếp với dòng 7 thành 1 câu lệnh)

Điều kiện nếu Tr =8 ( = với mặc định; Nghĩa là ta không cung cấp tham trị) thì macro sẽ làm cái việc như sau:

Cách vế fía fải 18 ô, mở rọng thêm 1 ô sẽ được gán trị bỡi vùng (2) ô từ ô cách ô đầu của Rg0 Col2 ô
D7 gốm 2 câu lệnh íiết chung;
Câu đầu là: Tăng cho biến toàn cục TT lên 1 đơn vị;
Câu sau là: Ô trái liền kề vớ mô ta tuyên cáo làm việc được gán trị từ biện TT
D9: Kết thúc/Hết tuyên cáo

Chờ fát biểu từ bạn cái đã, nhỉ!
Nhấp chuột vào đây để mở rộng...


Chào bác ChanhTQ@,
Với đoạn Macro này mình giải thích áp dụng thực tế vào bài toán không biết hiểu như sau có đúng không:

- D1+2: Như bạn giải thích;

Cụ thể việc thực hiện tính toán tại sheet Check_Name là:

- D3: Lấy ô B11 làm mốc bắt đầu tính toán (ô tuyên bố làm việc);

- D4: Tính cả từ ô B11 mở rộng về bên phải 8 ô (đến ô I11). Giá trị ghi vào các ô này [$B$11:$I$11] = Rg0 (tức ghi giá trị lần lượt vào bắt đầu từ ô B11, C11, D11,... đến I11);

- D5: Tính cả từ ô B11 mà ta tuyên bố làm mốc tính toán ta dịch sang trái 8 ô (đến ô I11) rồi mở rộng về phải thêm 6 ô nữa - tức mở rộng kể từ ô J11 đến hết ô O11. Khi đó giá trị ghi vào các ô này [$J$11:$O$11] = Rg0(9) (tức ghi giá trị lần lượt vào bắt đầu từ ô thứ 9 là ô J11, rồi ô K11, L11,... đến O11 ~ việc mở rộng 6 ô về phía phải);

- D6+7: Thỏa mãn điều kiện Tr=8 thì thực hiện: Tính cả từ ô B11 tuyên bố làm mốc tính toán ta dịch về bên phải 18 ô rồi mở rộng thêm 2 ô nữa - tức mở hai ô T11 và U11. Giá trị ghi vào lúc này = Rg0(15) (tức ghi giá trị lần lượt vào bắt đầu từ ô thứ 15 là ô P11, rồi các ô bên phải);

- D8+9: như bác giải thích.

Bác ChanhTQ@ và các thầy chỉ giáo!
 
Upvote 0
Tác giả topic đã hiểu vấn đề rồi đó

Tổng quát thì ta hiểu macro sẽ chép số liệu vô 3 vùng trong 1 dòng ta chọn gồm vùng đầu, vùng giữa & vùng cuối;

Trong mọi trường hợp nó chếp theo các thông số mà ta lấy mặc định hay cung cấp mới cho nó

(1) Vùng đầu
Ở vùng này thường sẩy ra 2 trường hợp
a./ Dòng dữ liệu mới xuất hiện thì chép 8 ô
b./ Dòng dữ liệu đã 'trùng': Chép 1 ô

(2) Ở vùng cuối: Trong trường hợp a./ bên trên: Chép 2 ô; Trường hợp còn lại: Mần 1 ô

(3) Đoạn giữa có thể có 3 trường hợp theo 3 cấu trúc rất 'Trật tự' của bạn mà mần.
Chuyện này bạn hoàn toàn có quyền nghiên cứu tiếp!
Coi như các trường hợp tương đương với số cột trong 3 trang tính chứa dữ liệu của bạn!
 
Upvote 0
HYen17 đã viết:
Tổng quát thì ta hiểu macro sẽ chép số liệu vô 3 vùng trong 1 dòng ta chọn gồm vùng đầu, vùng giữa & vùng cuối;

Trong mọi trường hợp nó chếp theo các thông số mà ta lấy mặc định hay cung cấp mới cho nó

(1) Vùng đầu
Ở vùng này thường sẩy ra 2 trường hợp
a./ Dòng dữ liệu mới xuất hiện thì chép 8 ô
b./ Dòng dữ liệu đã 'trùng': Chép 1 ô

(2) Ở vùng cuối: Trong trường hợp a./ bên trên: Chép 2 ô; Trường hợp còn lại: Mần 1 ô

(3) Đoạn giữa có thể có 3 trường hợp theo 3 cấu trúc rất 'Trật tự' của bạn mà mần.
Chuyện này bạn hoàn toàn có quyền nghiên cứu tiếp!
Coi như các trường hợp tương đương với số cột trong 3 trang tính chứa dữ liệu của bạn!
Nhấp chuột vào đây để mở rộng...

Mặc dù đã hiểu bản chất nhưng khi em thực hiện nhúng đoạn macro cũng như đoạn code vào file đang sử dụng thực tế, không hiểu đang gặp lỗi ở đâu mà chưa được. Em xin gửi file để nhờ bác xử lý giúp.

Chăm sự nhờ vào bác và các thầy.
 

File đính kèm

Upvote 0
Bạn fải xài câu lệnh này, macro mới tìm ra dữ liệu:
PHP: 
        Set Rng = Sh.Range(Sh.[d1], Sh.[d65500].End(xlUp))

& Bạn cày tiếp đi nha, triễn vọng lắm đó!
 
Upvote 0
hackeridc đã viết:
Nhờ thầy submit nốt giúp em với chứ "em bị tẩu hỏa nhập ma" mất rồi ;;;;;;;;;;; !!!
Nhấp chuột vào đây để mở rộng...

Tớ đã làm xem có giúp gì cho bạn được không nhưng đúng thất sự là nó cứ lộn xộn ô này ô kia như thế nào ấy, hix :cc_surrender:.
Đừng nói là tớ tẩu hỏa nhập ma như bạn nhé :fool:... Chắc phải nhờ tới sự ra tay của các cao thủ rồi bạn ơi.
Các thầy xem làm giúp đi, em cũng đang muốn tìm hiểu bài toán này :help:.
 
Upvote 0
Nhờ thầy submit nốt giúp em với chứ "em bị tẩu hỏa nhập ma" mất rồi !!!
Nhấp chuột vào đây để mở rộng...

Bạn chép macro này vô thay thế, chạy thử ^ cho biết lỗi còn ở đâu nữa.

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 If Not Intersect(Target, [E2]) Is Nothing Then
    Rw = [B4].CurrentRegion.Rows.Count
    [A5].Resize(Rw, 22).Clear:                 TT = 0
    For J = 1 To 4
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[d1], Sh.[d65500].End(xlUp))          '<=|'
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -1).Resize(, J * 24 + 27)
                If J = 1 Then
                    GPE
                ElseIf J = 2 Then
                    GPE 45
                    GPE 45, 24, 41, 2
                ElseIf J = 3 Then
                    GPE 58
                    GPE 58, 24, 39, 2
                    GPE 58, 24, 54, 2
                ElseIf J = 4 Then
                    GPE 61
                    GPE 61, 24, 35, 2
                    GPE 61, 24, 46, 2
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B4].CurrentRegion.Rows.Count
    Set Rng = [B4].Resize(Rw, 22)
    Rng.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 End If
End Sub
 
Upvote 0
ChanhTQ@ đã viết:
Bạn chép macro này vô thay thế, chạy thử ^ cho biết lỗi còn ở đâu nữa.

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 If Not Intersect(Target, [E2]) Is Nothing Then
    Rw = [B4].CurrentRegion.Rows.Count
    [A5].Resize(Rw, 22).Clear:                 TT = 0
    For J = 1 To 4
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[d1], Sh.[d65500].End(xlUp))          '<=|'
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -1).Resize(, J * 24 + 27)
                If J = 1 Then
                    GPE
                ElseIf J = 2 Then
                    GPE 45
                    GPE 45, 24, 41, 2
                ElseIf J = 3 Then
                    GPE 58
                    GPE 58, 24, 39, 2
                    GPE 58, 24, 54, 2
                ElseIf J = 4 Then
                    GPE 61
                    GPE 61, 24, 35, 2
                    GPE 61, 24, 46, 2
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B4].CurrentRegion.Rows.Count
    Set Rng = [B4].Resize(Rw, 22)
    Rng.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 End If
End Sub
Nhấp chuột vào đây để mở rộng...

Bác ChanhTQ@ ơi, vẫn bị lỗi bác ạ:

1. Dữ liệu từ các sheet Report1, 2, 3 & 4 khi đổ về các cell ở sheet Filter_Report vẫn lộn xộn, không đúng vị trí đã quy định theo tiêu đề.

2. Thiếu hẳn một cột dữ liệu Số phiếu => Dữ liệu ở các cột còn lại bị đẩy sang trái một cột.

3. Trong file gửi kèm em có sửa lại đoạn code ở Modul1.

Nhờ bác ChanhTQ@ xử lý giúp em với nhé.
Trân trọng cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Anh ơi, anh giải thích luôn những dòng lệnh trong sheet Check_Name luôn đi, càng tường tận càng tốt anh nhé :
Nhấp chuột vào đây để mở rộng...
PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
4 If Not Intersect(Target, [D7]) Is Nothing Then
       Rw = [B9].CurrentRegion.Rows.Count
6     [A11].Resize(Rw, 22).Clear: TT = 0
      For J = 1 To 3
8         Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
          Set Rng = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
10        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
          If Not sRng Is Nothing Then
12              fAdd = sRng.Address
                 Do
14                    Set Rg0 = sRng.Offset(, -1).Resize(, J * 10 + 13)
                       If J = 1 Then
16                            GPE
                       ElseIf J = 2 Then
18                               GPE 25
                                  GPE 25, 8, 17, 2
20                       ElseIf J = 3 Then
                                 GPE 39
22                                 GPE 39, 10, 19, 2
                                 GPE 39, 10, 29, 2
24                           End If
                          Set sRng = Rng.FindNext(sRng)
26                   Loop While Not sRng Is Nothing And sRng.Address <> fAdd
             End If
28       Next J
          Rw = [B9].CurrentRegion.Rows.Count
30          Set Rng = [B11].Resize(Rw, 22)
          Rng.Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal
32  End If
End Sub

3 dòng lệnh trên D4 là khai báo các biến cần thiết
D4: Nếu thay đổi dữ lêệu trong ô [D7] thì thực hiện các lệnh trong macro này
D5: Lấy số dòng của vùng xung quanh [B9] gán vô biến đã khai báo
D6: Thiết lập vòng lặp để duyệt 3 trang tính;

D6 gồm 2 câu lệnh; Câu đầu là xóa dữ liệu cũ do chạy macro lần trước tạo ra;
Câu lệnh sau: Cho trị trong biến toàn cục về 0
D7: Thiết lập vòng lặp duyệt lần lượt theo 3 trang tính
Vòng lặp kết thúc tại D28
D8: Lấy lần lượt từng trang tính ứng với chỉ số biến thiên của vòng lặp đem gán vô biến đố tượng Sh đã khai báo
D9: Đem vùng có dữ liệu của cột [C] gán vô biến kiểu vùng đã khai báo;
Cột dữ liệu này chính là trường tên công ti mà ta cần tìm kiếm
D10: Thức hiện fương thức tìm kiếm trong vùng chứa dữ liệu cột [C], fương cách tìm quan trọng ở đây là tìm 1 fần của tên công ti;
D11: Nếu tìm thấy thì thực hiện tiếp các lệnh liền kề cho tới dòng lệnh mang số 27
D12: Lấy địa chỉ ô tìm thấy đem gán vô biến kiểu chuỗi đã khai báo;
D13: Thiết lập vòng lặp Do …. Loop (D26) để liên tục xử lí các dữ liệu được tìm thấy
D14: Đem vùng trong 1 hàng kể từ ơ trái liền kề với ô tìm thấy, mở rọng về fía fải với lượng tương ứng với biến chạy J gàn cho biến vùng đã khai báo trước;
D15: Lập điều kiện khi J = 1
D16: Gọi macro con, iêu cầu là macro này chạy với 4 thông số mặc định
D17:D23: Gọi macro GPE với các tham biến khác nhau, tùy thuộc vô biến chạy J
D24: Kết thúc điều kiện (fát sinh từ D15 bên trên)
D25: Tiếp tục tìm kiếm trong cột dữ liệu
D26: Điều kiện để dừng tìm kiếm; Tạm hiểu là việc tìm kiếm sẽ dừng lại khi ô tìm thấy có địa chỉ trùng với địa chỉ đầu tiên ta đã tìm thấy; Địa chỉ này ta đã ghi lại trong biến chuỗi trước khi đi vô vòng lặp Do . . . Loop
D27:D28: Xem lại bên trên
D29: Đếm số dòng thu được & đem gán vô biến đã khai báo
D30: Đem vùng thu được, bao gồm cả tiêu đề gán vô biến vùng Rng
D31: Thực hiện fương thức sắp xếp lại (theo iêu cầu của chủ topic là xếp theo số hóa đơn)- Sắp xếp theo cột
. . .

Những mong giúp được bạn ít nhiều!
 
Upvote 0
Cũng tại bạn thôi; Giờ bạn thử gọt giầy theo chân xem sao!

[Thongbao]Bác ơi, vẫn bị lỗi bác ạ:

1. Dữ liệu từ các sheet Report1, 2, 3 & 4 khi đổ về các cell ở sheet Filter_Report vẫn lộn xộn, không đúng vị trí đã quy định theo tiêu đề.

2. Thiếu hẳn một cột dữ liệu Số phiếu => Dữ liệu ở các cột còn lại bị đẩy sang trái một cột.

3. Trong file gửi kèm em có sửa lại đoạn code ở Modul1.

Xin cảm ơn![/thongbao]
 
Upvote 0
[COLOR=#000000 đã viết:
Cũng tại bạn thôi; Giờ bạn thử gọt giầy theo chân xem sao![/COLOR]
Nhấp chuột vào đây để mở rộng...

Em cũng đã gọt rồi đấy chứ bác, gọt nhiều quá chảy cả máu chân :., nên em đành nhờ bác và các thầy gọt giúp mà.
Rất mong bác xử lý giúp em, trân trọng!
 
Upvote 0
hackeridc đã viết:
Em cũng đã gọt rồi đấy chứ bác, gọt nhiều quá chảy cả máu chân :., nên em đành nhờ bác và các thầy gọt giúp mà.
Rất mong bác xử lý giúp em, trân trọng!
Nhấp chuột vào đây để mở rộng...

Cũng dễ hiểu và thông cảm cho bác ấy thôi vì em cũng đang gặp phải hoàn cảnh của bạn khi thử giải bài toán này.
@ Anh HYen17 có thể giải giúp, ngay cả em cũng muốn học hỏi.
 
Upvote 0
ChanhTQ@ đã viết:
PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
4 If Not Intersect(Target, [D7]) Is Nothing Then
       Rw = [B9].CurrentRegion.Rows.Count
6     [A11].Resize(Rw, 22).Clear: TT = 0
      For J = 1 To 3
8         Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
          Set Rng = Sh.Range(Sh.[c1], Sh.[c65500].End(xlUp))
10        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
          If Not sRng Is Nothing Then
12              fAdd = sRng.Address
                 Do
14                    Set Rg0 = sRng.Offset(, -1).Resize(, J * 10 + 13)
                       If J = 1 Then
16                            GPE
                       ElseIf J = 2 Then
18                               GPE 25
                                  GPE 25, 8, 17, 2
20                       ElseIf J = 3 Then
                                 GPE 39
22                                 GPE 39, 10, 19, 2
                                 GPE 39, 10, 29, 2
24                           End If
                          Set sRng = Rng.FindNext(sRng)
26                   Loop While Not sRng Is Nothing And sRng.Address <> fAdd
             End If
28       Next J
          Rw = [B9].CurrentRegion.Rows.Count
30          Set Rng = [B11].Resize(Rw, 22)
          Rng.Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal
32  End If
End Sub

3 dòng lệnh trên D4 là khai báo các biến cần thiết
D4: Nếu thay đổi dữ lêệu trong ô [D7] thì thực hiện các lệnh trong macro này
D5: Lấy số dòng của vùng xung quanh [B9] gán vô biến đã khai báo
D6: Thiết lập vòng lặp để duyệt 3 trang tính;

D6 gồm 2 câu lệnh; Câu đầu là xóa dữ liệu cũ do chạy macro lần trước tạo ra;
Câu lệnh sau: Cho trị trong biến toàn cục về 0
D7: Thiết lập vòng lặp duyệt lần lượt theo 3 trang tính
Vòng lặp kết thúc tại D28
D8: Lấy lần lượt từng trang tính ứng với chỉ số biến thiên của vòng lặp đem gán vô biến đố tượng Sh đã khai báo
D9: Đem vùng có dữ liệu của cột [C] gán vô biến kiểu vùng đã khai báo;
Cột dữ liệu này chính là trường tên công ti mà ta cần tìm kiếm
D10: Thức hiện fương thức tìm kiếm trong vùng chứa dữ liệu cột [C], fương cách tìm quan trọng ở đây là tìm 1 fần của tên công ti;
D11: Nếu tìm thấy thì thực hiện tiếp các lệnh liền kề cho tới dòng lệnh mang số 27
D12: Lấy địa chỉ ô tìm thấy đem gán vô biến kiểu chuỗi đã khai báo;
D13: Thiết lập vòng lặp Do …. Loop (D26) để liên tục xử lí các dữ liệu được tìm thấy
D14: Đem vùng trong 1 hàng kể từ ơ trái liền kề với ô tìm thấy, mở rọng về fía fải với lượng tương ứng với biến chạy J gàn cho biến vùng đã khai báo trước;
D15: Lập điều kiện khi J = 1
D16: Gọi macro con, iêu cầu là macro này chạy với 4 thông số mặc định
D17:D23: Gọi macro GPE với các tham biến khác nhau, tùy thuộc vô biến chạy J
D24: Kết thúc điều kiện (fát sinh từ D15 bên trên)
D25: Tiếp tục tìm kiếm trong cột dữ liệu
D26: Điều kiện để dừng tìm kiếm; Tạm hiểu là việc tìm kiếm sẽ dừng lại khi ô tìm thấy có địa chỉ trùng với địa chỉ đầu tiên ta đã tìm thấy; Địa chỉ này ta đã ghi lại trong biến chuỗi trước khi đi vô vòng lặp Do . . . Loop
D27:D28: Xem lại bên trên
D29: Đếm số dòng thu được & đem gán vô biến đã khai báo
D30: Đem vùng thu được, bao gồm cả tiêu đề gán vô biến vùng Rng
D31: Thực hiện fương thức sắp xếp lại (theo iêu cầu của chủ topic là xếp theo số hóa đơn)- Sắp xếp theo cột
. . .

Những mong giúp được bạn ít nhiều!
Nhấp chuột vào đây để mở rộng...


Xem ra cũng phức tạp đấy chứ nhì, nhất là lại với một người đang bắt đầu từ con số 0 như mình. Cảm ơn anh nhiều nhé.
Nhân đây nhờ anh giải thực tế giúp luôn bài toán của anh hackeridc đang bị... "tẩu hỏa nhập ma" vì em cũng làm nhưng chưa thành công.
 

File đính kèm

Upvote 0
. . .
Nhân đây nhờ anh giải thực tế giúp luôn bài toán của anh hackeridc đang bị... "tẩu hỏa nhập ma" vì em cũng làm nhưng chưa thành công.
Nhấp chuột vào đây để mở rộng...

Bạn thử sửa câu lệnh thành
PHP: 
Set Rg0 = sRng.Offset(, -2).Resize(, J * 24 + 27)

& chạy thử xem sao?
 
Upvote 0
ChanhTQ@ đã viết:
Bạn thử sửa câu lệnh thành
PHP: 
Set Rg0 = sRng.Offset(, -2).Resize(, J * 24 + 27)

& chạy thử xem sao?
Nhấp chuột vào đây để mở rộng...

Bác ơi mới chỉ giải quyết được vấn đề thứ 2 mà em đã nêu (2. Thiếu hẳn một cột dữ liệu Số phiếu => Dữ liệu ở các cột còn lại bị đẩy sang trái một cột.)
Các dữ liệu từ các sheet Report1,2,3&4 khi đổ về sheet Filter_Report bị lỗi từ cột Y trở về bên phải (không đổ vào đúng cell theo tiêu đề quy định).
Bác xem giúp em với, hix
 
Upvote 0
Chắc viết lại từ đầu dễ hơn sửa!

,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
 
Upvote 0
Fải công nhận rằng mình quá kiên trì & nhẫnại luôn!

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 
 If Not Intersect(Target, [E2]) Is Nothing Then
    Rw = [B4].CurrentRegion.Rows.Count
    [B5].Resize(Rw, 60).Clear:                          TT = 0
    For J = 1 To 4
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[d4], Sh.[d65500].End(xlUp))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -2).Resize(, 65)
                If J = 1 Then
                    [b999].End(xlUp).Offset(1).Resize(, 60).Value = Rg0.Value
                ElseIf J = 2 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 39).Value = Rg0.Value
                        .Offset(, 51).Resize(, 9).Value = Rg0.Offset(, 39).Resize(, 9).Value
                        .Resize(, 2).Interior.ColorIndex = 34
                    End With
                ElseIf J = 3 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 37).Value = Rg0.Value
                        .Offset(, 51).Value = Rg0.Offset(, 37).Value
                        .Offset(, 52).Resize(, 8).Value = Rg0.Offset(, 53).Resize(, 8).Value
                        .Resize(2, 3).Interior.ColorIndex = 37
                        
                        .Offset(1).Resize(, 23).Value = Rg0.Value
                        .Offset(1, 23).Resize(, 4).Value = Rg0.Offset(, 38).Resize(, 4).Value
                        .Offset(1, 37).Resize(, 10).Value = Rg0.Offset(, 42).Resize(, 10).Value
                        .Offset(1, 51).Resize(, 9).Value = Rg0.Offset(, 52).Resize(, 9).Value
                    End With
                ElseIf J = 4 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 33).Value = Rg0.Value
                        .Offset(, 51).Value = Rg0.Offset(, 33).Value
                        .Offset(, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                        .Resize(3, 4).Interior.ColorIndex = 39
                        
                        .Offset(1).Resize(, 23).Value = Rg0.Value
                        .Offset(1, 23).Resize(, 4).Value = Rg0.Offset(, 34).Resize(, 4).Value
                        .Offset(1, 33).Resize(, 6).Value = Rg0.Offset(, 38).Resize(, 6).Value
                        .Offset(1, 51).Value = Rg0.Offset(, 44).Value
                        .Offset(1, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                        
                        .Offset(2).Resize(, 23).Value = Rg0.Value
                        .Offset(2, 23).Resize(, 4).Value = Rg0.Offset(, 45).Resize(, 4).Value
                        .Offset(2, 39).Resize(, 6).Value = Rg0.Offset(, 49).Resize(, 6).Value
                        .Offset(2, 51).Value = Rg0.Offset(, 55).Value
                        .Offset(2, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                    End With
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B4].CurrentRegion.Rows.Count
    Set Rng = [B4].Resize(Rw, 61)
    Rng.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 End If
End Sub
 
Upvote 0
SA_DQ đã viết:
[h=2]Fải công nhận rằng mình quá kiên trì & nhẫnại luôn!
[/h]
Nhấp chuột vào đây để mở rộng...

Tôi cũng bái phục sự nhẫn nại của bác. Toàn là dân "bắt đầu từ số 0 [sic]" mà đòi hỏi toàn những chuyện màu mè mắm muối cành đủ cỡ.

Tôi khuyến khích học hỏi. Không biết thì phải hỏi. Nhưng chưa học được bao nhiêu mà rớ vào những cái đồ sộ tráng lệ thì rốt cuộc chỉ thấy "bác giúp em chút nữa..., bây giờ lại nảy sinh..., sao em làm mà nó không chạy..., vân vân và vân vân"
 
Upvote 0
SA_DQ đã viết:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim J As Byte, Rw As Long
 Dim fAdd As String
 
 If Not Intersect(Target, [E2]) Is Nothing Then
    Rw = [B4].CurrentRegion.Rows.Count
    [B5].Resize(Rw, 60).Clear:                          TT = 0
    For J = 1 To 4
        Set Sh = ThisWorkbook.Worksheets("Report" & CStr(J))
        Set Rng = Sh.Range(Sh.[d4], Sh.[d65500].End(xlUp))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            fAdd = sRng.Address
            Do
                Set Rg0 = sRng.Offset(, -2).Resize(, 65)
                If J = 1 Then
                    [b999].End(xlUp).Offset(1).Resize(, 60).Value = Rg0.Value
                ElseIf J = 2 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 39).Value = Rg0.Value
                        .Offset(, 51).Resize(, 9).Value = Rg0.Offset(, 39).Resize(, 9).Value
                        .Resize(, 2).Interior.ColorIndex = 34
                    End With
                ElseIf J = 3 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 37).Value = Rg0.Value
                        .Offset(, 51).Value = Rg0.Offset(, 37).Value
                        .Offset(, 52).Resize(, 8).Value = Rg0.Offset(, 53).Resize(, 8).Value
                        .Resize(2, 3).Interior.ColorIndex = 37
                        
                        .Offset(1).Resize(, 23).Value = Rg0.Value
                        .Offset(1, 23).Resize(, 4).Value = Rg0.Offset(, 38).Resize(, 4).Value
                        .Offset(1, 37).Resize(, 10).Value = Rg0.Offset(, 42).Resize(, 10).Value
                        .Offset(1, 51).Resize(, 9).Value = Rg0.Offset(, 52).Resize(, 9).Value
                    End With
                ElseIf J = 4 Then
                    With [b999].End(xlUp).Offset(1)
                        .Resize(, 33).Value = Rg0.Value
                        .Offset(, 51).Value = Rg0.Offset(, 33).Value
                        .Offset(, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                        .Resize(3, 4).Interior.ColorIndex = 39
                        
                        .Offset(1).Resize(, 23).Value = Rg0.Value
                        .Offset(1, 23).Resize(, 4).Value = Rg0.Offset(, 34).Resize(, 4).Value
                        .Offset(1, 33).Resize(, 6).Value = Rg0.Offset(, 38).Resize(, 6).Value
                        .Offset(1, 51).Value = Rg0.Offset(, 44).Value
                        .Offset(1, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                        
                        .Offset(2).Resize(, 23).Value = Rg0.Value
                        .Offset(2, 23).Resize(, 4).Value = Rg0.Offset(, 45).Resize(, 4).Value
                        .Offset(2, 39).Resize(, 6).Value = Rg0.Offset(, 49).Resize(, 6).Value
                        .Offset(2, 51).Value = Rg0.Offset(, 55).Value
                        .Offset(2, 52).Resize(, 8).Value = Rg0.Offset(, 56).Resize(, 8).Value
                    End With
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        End If
    Next J
    Rw = [B4].CurrentRegion.Rows.Count
    Set Rng = [B4].Resize(Rw, 61)
    Rng.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 End If
End Sub
Nhấp chuột vào đây để mở rộng...

Dù có muộn nhưng lời đầu tiên em phải nói là rất cảm ơn bác SA_DQ đã dành thời gian (chỉ 1s) để giải giúp em bài toán này. Toàn bộ số liệu đổ về rất chính xác. Chỉ có mấy vấn đề rất nhỏ (mà trước đấy bác ChanhTQ@ và HYen17 đã xử lý giúp em):

1. Cột số TT không nhảy số

2. Nếu trong 1 số phiếu có 3 mặt hàng thì làm sao thay vì hiển thị cả 3 dòng ta chỉ cho hiển thị 1 dòng thông tin: Số phiếu, Tham chiếu thời gian, Bên nhận,... cho đến Giao tại; Còn TTTB vẫn hiển thị lần lượt như cũ;

3. Giữ nguyên các đinh dạng trước đó của bảng tính (Lề phải, trái, giữa, kẻ ô,...)

THẬT SỰ CẢM ƠN BÁC RẤT NHIỀU, RẤT RẤT NHIỀU!
 
Upvote 0
1. Cột số TT không nhảy số

2. Nếu trong 1 số phiếu có 3 mặt hàng thì làm sao thay vì hiển thị cả 3 dòng ta chỉ cho hiển thị 1 dòng thông tin: Số phiếu, Tham chiếu thời gian, Bên nhận,... cho đến Giao tại; Còn TTTB vẫn hiển thị lần lượt như cũ;

3. Giữ nguyên các đinh dạng trước đó của bảng tính (Lề phải, trái, giữa, kẻ ô,...)
Nhấp chuột vào đây để mở rộng...

(1) Chuyện này bạn hoàn toàn có thể làm được, sau khi đọc những gợi í sau:

Tại cột [A],sau dòng tiêu đế [A4] ta lập công thức: Nếu cột bên fải liền kề trống thì để trống, nếu có dữ liệu thì [A5] nhận giá trị là 1
Công thức dưới nó cũng na ná vậy: Nếu [B6] có dữ liệu, thì [A6] nhận giá trị ô trên nó thêm 1; Nếu trống thì để trống.
Sau đó dùng fương thức FillDown xuống đến đâu mà bạn muốn;

(2) Iêu cầu của bạn từ bài đầu là sắp xếp theo [Số Fiếu]; Giờ bỏ cái này thì làm sao xếp đây?
Nên nhớ rằng câu lệnh cuối cùng là sắp xếp theo [Số Fiếu]; Nhưng ta không cho nó hiện thì làm sao xếp?

(3) . . . . . ??? Chuyện này là không tưởng.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm (1 người xem)
Trả lời
23
Đọc
267
LamNA
LamNA
phuongnam366377
VbaTools – Bộ công cụ mở rộng cho VBA trong Excel
Trả lời
8
Đọc
127
phuongnam366377
phuongnam366377
Tuanba1992
Lập trình Excel có thể dùng ngôn ngữ lập trình nào? (1 người xem)
Trả lời
7
Đọc
273
Tuanba1992
Tuanba1992
L
Nhờ giúp đỡ công thức tính công từ dữ liệu trích xuất ra từ File chấm công (1 người xem)
Trả lời
0
Đọc
34
lưu tuấn dũng
L
H
Excel không lọc được toàn bộ dữ liệu (1 người xem)
Trả lời
0
Đọc
36
Hongphong123
H
H
Tổng hợp Công Nợ theo Công trình
Trả lời
27
Đọc
402
HangktGTN
H
H
  • Đã khóa
Công Thức Tính Tổng Công Nợ Khách Hàng
Trả lời
1
Đọc
43
ptm0412
ptm0412
B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn (1 người xem)
Trả lời
8
Đọc
139
ptm0412
ptm0412
GPE-Trợ Lý
CHÀO MỪNG 80 NĂM QUỐC KHÁNH
    • Thích
    • Yêu thích
Trả lời
0
Đọc
52
GPE-Trợ Lý
GPE-Trợ Lý
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
7
Đọc
284
tranhungdao12a3
T
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ (1 người xem)
Trả lời
10
Đọc
403
Thaik05
T
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10
    • Yêu thích
    • Thích
Trả lời
24
Đọc
2K
nguyendang95
N
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
13
Đọc
2K
huhumalu
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
12
Đọc
387
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ !
Trả lời
5
Đọc
148
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
108
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
675
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file.
Trả lời
10
Đọc
483
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom