Giúp code lấy dữ liệu từ 1 Sheet có dòng lấy số liệu không cố định! (2 người xem)

[LienDong]

Các bạn giúp mình code như sau:
Sheet LOP3 sẽ lấy dữ liệu từ sheet TH qua
Nhờ các bạn giúp mẫu này, để mình làm lớp khác
Mình có mô tả chi tiết trong File đính kèm, xin cảm ơn các bạn!

 

[Hoàng Trọng Nghĩa]

Các bạn giúp mình code như sau:
Sheet LOP3 sẽ lấy dữ liệu từ sheet TH qua
Nhờ các bạn giúp mẫu này, để mình làm lớp khác
Mình có mô tả chi tiết trong File đính kèm, xin cảm ơn các bạn!

File của bạn chẳng có một dữ liệu thực tế nào cả, làm sao giúp bạn được đây?

Gợi ý, đã có các mã 1111, 2222, 3333, ... thì dùng hàm SUMIF hoặc SUMPRODUCT (nếu có thêm điều kiện là LỚP) đã đáp ứng được công việc của bạn, cần chi đến CODE!

 

[LienDong]

File của bạn chẳng có một dữ liệu thực tế nào cả, làm sao giúp bạn được đây?

Gợi ý, đã có các mã 1111, 2222, 3333, ... thì dùng hàm SUMIF hoặc SUMPRODUCT (nếu có thêm điều kiện là LỚP) đã đáp ứng được công việc của bạn, cần chi đến CODE!

Cảm ơn bạn, trong file cũng có số 1000 và 3000 đó bạn, mình để như vậy là để nhìn thôi
Dùng Sumif() thì mình biết rồi, mình đang tập tọe code đó bạn!

 

[Hoàng Trọng Nghĩa]

Cảm ơn bạn, trong file cũng có số 1000 và 3000 đó bạn, mình để như vậy là để nhìn thôi
Dùng Sumif() thì mình biết rồi, mình đang tập tọe code đó bạn!

Đã là mã số thì số "quái" nào mà chẳng được bạn! Nhưng tôi nói rằng file bạn gửi lên không thực tế, lấy cái gì để người ta thao tác và tính toán đây?

 

[LienDong]

Đã là mã số thì số "quái" nào mà chẳng được bạn! Nhưng tôi nói rằng file bạn gửi lên không thực tế, lấy cái gì để người ta thao tác và tính toán đây?

Đây mình gởi File có thêm số liệu đây!

 

[dhn46]

Bạn tham khảo Code sau:
Nếu dữ liệu mẫu "Chuẩn" và đầy đủ thì có những giải pháp hay hơn

Sub Loc()
    Dim i As Long, k As Long, Arr, ArrData, ResArr, sArr, Dic As Object
    ArrData = Sheet2.Range("A6:P" & Sheet2.Range("E65536").End(3).Row)
    sArr = Sheet1.Range("B10:H" & Sheet1.Range("B65536").End(3).Row)
    ReDim Arr(1 To UBound(ArrData), 1)
    ReDim ResArr(1 To UBound(sArr), 1 To 2)


    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic


        For i = 1 To UBound(ArrData)
            If Not .exists(ArrData(i, 5)) Then
                k = k + 1
                .Add ArrData(i, 5), k
                Arr(k, 1) = ArrData(i, 11)    'Ap dung cho Lop 3, Neu du lieu day du thi 1 vong lap cho cac lop
            Else
                Arr(.Item(ArrData(i, 5)), 1) = Arr(.Item(ArrData(i, 5)), 1) + ArrData(i, 11)  'Cong don cac ma
            End If
        Next


        For i = 1 To UBound(sArr)
            If .exists(sArr(i, 1) & "T") Or .exists(sArr(i, 1) & "C") Then
                If .exists(sArr(i, 1) & "T") Then ResArr(i, 1) = Arr(.Item(sArr(i, 1) & "T"), 1)
                If .exists(sArr(i, 1) & "C") Then ResArr(i, 2) = Arr(.Item(sArr(i, 1) & "C"), 1)
            Else
                ResArr(i, 1) = sArr(i, 6)
                ResArr(i, 2) = sArr(i, 7)
            End If
        Next
    End With
    Sheet1.[G10].Resize(UBound(ResArr), 2) = ResArr
End Sub

 

[LienDong]

Bạn tham khảo Code sau:
Nếu dữ liệu mẫu "Chuẩn" và đầy đủ thì có những giải pháp hay hơn

Sub Loc()
    Dim i As Long, k As Long, Arr, ArrData, ResArr, sArr, Dic As Object
    ArrData = Sheet2.Range("A6:P" & Sheet2.Range("E65536").End(3).Row)
    sArr = Sheet1.Range("B10:H" & Sheet1.Range("B65536").End(3).Row)
    ReDim Arr(1 To UBound(ArrData), 1)
    ReDim ResArr(1 To UBound(sArr), 1 To 2)


    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic


        For i = 1 To UBound(ArrData)
            If Not .exists(ArrData(i, 5)) Then
                k = k + 1
                .Add ArrData(i, 5), k
                Arr(k, 1) = ArrData(i, 11)    'Ap dung cho Lop 3, Neu du lieu day du thi 1 vong lap cho cac lop
            Else
                Arr(.Item(ArrData(i, 5)), 1) = Arr(.Item(ArrData(i, 5)), 1) + ArrData(i, 11)  'Cong don cac ma
            End If
        Next


        For i = 1 To UBound(sArr)
            If .exists(sArr(i, 1) & "T") Or .exists(sArr(i, 1) & "C") Then
                If .exists(sArr(i, 1) & "T") Then ResArr(i, 1) = Arr(.Item(sArr(i, 1) & "T"), 1)
                If .exists(sArr(i, 1) & "C") Then ResArr(i, 2) = Arr(.Item(sArr(i, 1) & "C"), 1)
            Else
                ResArr(i, 1) = sArr(i, 6)
                ResArr(i, 2) = sArr(i, 7)
            End If
        Next
    End With
    Sheet1.[G10].Resize(UBound(ResArr), 2) = ResArr
End Sub

Cảm ơn bạn giúp mình, sao mình thay đổi sang Lop4 thì code nó kg chạy?
Xin lỗi các bạn, vì dữ liệu mình nó như đám rừng, nên mình đưa dữ liệu đơn giản cho dễ nhìn, mình đã đổi File ở bài 5 mà sao nó vẫn như cũ!!!
Bạn giúp mình sửa code để có thể tại Lop3, mình chạy code thì cũng lấy được số liệu, sang LOP4 chạy code thì vẫn lấy được số liệu ...
Mình gởi File mới nhờ các bạn xem lại!

 

[dhn46]

Cảm ơn bạn giúp mình, sao mình thay đổi sang Lop4 thì code nó kg chạy?
Xin lỗi các bạn, vì dữ liệu mình nó như đám rừng, nên mình đưa dữ liệu đơn giản cho dễ nhìn, mình đã đổi File ở bài 5 mà sao nó vẫn như cũ!!!
Bạn giúp mình sửa code để có thể tại Lop3, mình chạy code thì cũng lấy được số liệu, sang LOP4 chạy code thì vẫn lấy được số liệu ...
Mình gởi File mới nhờ các bạn xem lại!

Với những dữ liệu "mập mờ" như thế này thì rất "ngại" bởi nó có thể thay đổi mà có thay thì chỉ chủ nhân mới biết => người viết Code lại bị xoay vần theo ý của người tạo File.

Bạn LienDong cũng biết ít nhiều về Code, vậy mình gợi ý:
- Bạn mở cửa sổ VBA lên (Alt + F11) trong khung bên trái bạn để ý có Sheet1(Lop 3), Sheet2(TH) => đó là cấu trúc Sheet1(sheet Name)... (nếu thêm lớp thay sheet thì thay đổi cái này)
- Trong Code mình có ghi chú: ('Ap dung cho Lop 3, Neu du lieu day du thi 1 vong lap cho cac lop)
Nếu thay đổi lớp thì bạn thay đổi chữ in đậm, tăng dần theo thứ tự lớp

Arr(k, 1) = ArrData(i, [B]11[/B])

- Với dữ liệu chung chung thì ...bạn sẽ tự mò nhé!
Thân!

 

[LienDong]

Với những dữ liệu "mập mờ" như thế này thì rất "ngại" bởi nó có thể thay đổi mà có thay thì chỉ chủ nhân mới biết => người viết Code lại bị xoay vần theo ý của người tạo File.

Bạn LienDong cũng biết ít nhiều về Code, vậy mình gợi ý:
- Bạn mở cửa sổ VBA lên (Alt + F11) trong khung bên trái bạn để ý có Sheet1(Lop 3), Sheet2(TH) => đó là cấu trúc Sheet1(sheet Name)... (nếu thêm lớp thay sheet thì thay đổi cái này)
- Trong Code mình có ghi chú: ('Ap dung cho Lop 3, Neu du lieu day du thi 1 vong lap cho cac lop)
Nếu thay đổi lớp thì bạn thay đổi chữ in đậm, tăng dần theo thứ tự lớp

Arr(k, 1) = ArrData(i, [B]11[/B])

- Với dữ liệu chung chung thì ...bạn sẽ tự mò nhé!
Thân!

Cảm ơn sự nhiệt tình của bạn!
Mình thấy trên mạng người ta cũng hay viết 1 code chung mà có thể chạy cho nhiều sheet có cấu trúc giống nhau, về cấu trúc File của các lớp là như nhau, nên mình chỉ muốn 1 code là có thể chạy được cho lớp 1, lớp2, lớp3, ... và mỗi năm số lượng lớp nó sẽ khác nhau.
Riêng cấu trrúc của sheet TH là có thể thay đổi số dòng (thí dụ thêm mặt hàng nào đó thì bắt buộc nó phải thêm dòng)
Còn dữ liệu thì nó như bài 7, vì có những khoản thu hay chi của các lớp kg giống nhau, nên nó như vậy
Các bạn có thể giúp mình 1 lần, hoặc chỉ mình hướng khác!
XIN CẢM ƠN!

 

[concogia]

Cảm ơn sự nhiệt tình của bạn!
Mình thấy trên mạng người ta cũng hay viết 1 code chung mà có thể chạy cho nhiều sheet có cấu trúc giống nhau, về cấu trúc File của các lớp là như nhau, nên mình chỉ muốn 1 code là có thể chạy được cho lớp 1, lớp2, lớp3, ... và mỗi năm số lượng lớp nó sẽ khác nhau.
Riêng cấu trrúc của sheet TH là có thể thay đổi số dòng (thí dụ thêm mặt hàng nào đó thì bắt buộc nó phải thêm dòng)
Còn dữ liệu thì nó như bài 7, vì có những khoản thu hay chi của các lớp kg giống nhau, nên nó như vậy
Các bạn có thể giúp mình 1 lần, hoặc chỉ mình hướng khác!
XIN CẢM ƠN!

Việc viết một code chạy cho các sheet không khó, chỉ có ý kiến thế này với bạn
1)- Cấu trúc các sheet LOP như nhau : OK , có thêm bi nhiêu lớp cũng không sao
2)-

Riêng cấu trrúc của sheet TH là có thể thay đổi số dòng (thí dụ thêm mặt hàng nào đó thì bắt buộc nó phải thêm dòng)

Cái này cũng không sao
3)-

Còn dữ liệu thì nó như bài 7, vì có những khoản thu hay chi của các lớp kg giống nhau, nên nó như vậy

Cái này chưa hiểu lắm, mình thấy trong bài 7 cột tổng thu của các lớp nằm cùng hàng & tổng chi cũng thế mà
Túm lại, nếu dữ liệu ở sheet TH như thế thì bạn chỉ cần:
1)- Cho biết dấu hiệu nào báo hàng này là tổng thu, hàng kia là tổng chi ( như trong bài bạn dùng 3333T..)
2)- Tên các lớp trong sheet TH phải giống hoàn toàn với tên các sheet LOP
Bạn nên tạo cái bảng dữ liệu ở sheet TH cho nó giống..........cái bảng một tý. Híc
Thân

 

[LienDong]

3)-
Cái này chưa hiểu lắm, mình thấy trong bài 7 cột tổng thu của các lớp nằm cùng hàng & tổng chi cũng thế mà
Túm lại, nếu dữ liệu ở sheet TH như thế thì bạn chỉ cần:
1)- Cho biết dấu hiệu nào báo hàng này là tổng thu, hàng kia là tổng chi ( như trong bài bạn dùng 3333T..)
2)- Tên các lớp trong sheet TH phải giống hoàn toàn với tên các sheet LOP
Bạn nên tạo cái bảng dữ liệu ở sheet TH cho nó giống..........cái bảng một tý. Híc
Thân

Cảm ơn anh đã hướng dẫn và em đã làm lại File & giống như anh nói:
1/Cột tổng thu của các lớp nằm cùng hàng & tổng chi cũng vậy
2/Tên các lớp trong sheet TH phải giống hoàn toàn với tên các sheet LOP
Nhờ các bạn giúp đỡ. Xin cảm ơn !

 

[Quang_Hải]

1/Cột tổng thu của các lớp nằm cùng hàng & tổng chi cũng vậy
2/Tên các lớp trong sheet TH phải giống hoàn toàn với tên các sheet LOP
Nhờ các bạn giúp đỡ. Xin cảm ơn !

Tham gia 1 bài cho vui. Mấy cái này đơn giản , chỉ sợ là hỏng hiểu nhau thôi.

Sub loc()
Dim Data(), Res(), i, j, x
With Sheets("TH")
Data = .Range(.[E6], .[E65536].End(3)).Resize(, 12).Value
End With
Res = Range([A10], [A65536].End(3)).Resize(, 8).Value
For x = 5 To 12
   If ActiveSheet.Name = Data(1, x) Then
      For i = 1 To UBound(Res)
         For j = 2 To UBound(Data)
            If "TONG THU " & Res(i, 2) = Data(j, 1) Then
               Res(i, 7) = Data(j, x)
            ElseIf "TONG CHI " & Res(i, 2) = Data(j, 1) Then
               Res(i, 8) = Data(j, x)
            End If
         Next
      Next
   End If
Next
[A10].Resize(i - 1, 8) = Res
End Sub