[XIN TRỢ GIÚP] Tìm kiếm và Liệt kê

Liên hệ QC

NamThienVu

Thành viên chính thức
Tham gia
14/10/08
Bài viết
63
Được thích
16
Nghề nghiệp
Bank
Chào các bác trong GPE!

Em có 01 file làm ví dụ mong các Bác hỗ trợ!
Nhu cầu của em là Tìm kiếm dữ liệu trong các sheet "T1", "T2" và "T3" để lấy dữ liệu theo tên từng CBTD cột A và cột J tại 2 Vùng: Vùng Thu nợ (A:G) và Vùng Giải ngân (J:Q) rồi tự động điền vào sheet "Tong hop", đề nghị:

(1) Trong sheet "Tong hop", tại từng vùng liệt kê số liệu của từng CBTD sẽ lần lượt liệt kê số liệu từng tháng của từng CBTD, lần lượt hết T1 rồi đến T2 rồi đến T3 ==> không có ô trống tại các cột thể hiện phần Thu nợ. Riêng phần Giải ngân (trong sheet "Tong hop") thì lại có ô trống, của tháng nào thì hiện trong những dòng của tháng đó bên Thu nợ (ví dụ xem các cột AD đến AH ==> Mục đích là khi Filter theo tháng thì vẫn nhìn được chi tiết Thu nợ và Giải ngân trong từng tháng.

(2) Tại từng vùng liệt kê Thu nợ và Giải ngân trong sheet "Tong hop" sẽ sắp xếp các dòng dữ liệu theo chiều từ giá trị cao nhất xuống thấp nhất tương ứng với cột giá trị Thu nợ và giá trị Giải ngân (ví dụ cột AB và cột AH) ==> Đề nghị (2) không quan trọng bằng đề nghị (1), nếu làm được (2) thì càng tốt!!!

Em cảm ơn các bác nhiều nhiều!!!
 

File đính kèm

  • Tim_kiem_&_Liet_ke.xlsx
    770.5 KB · Đọc: 21
Đọc xong yêu cầu của bác cảm thấy xoắn não quá. Tải file về xem có rõ hơn chút nào không... xoắn não lần 2. Cảm nhận như lạc vào giữa rừng Amazon bác ạ :v
 
Đọc xong yêu cầu của bác cảm thấy xoắn não quá. Tải file về xem có rõ hơn chút nào không... xoắn não lần 2. Cảm nhận như lạc vào giữa rừng Amazon bác ạ :v
Thế để em gửi lại sau khi lượng hóa cho đơn giản và viết lại đơn giản, dễ hiểu hơn :D
 
Em xin được edit lại:

Nhu cầu của em là Tìm kiếm dữ liệu trong các sheet "T1" và "T2" để lấy dữ liệu theo tên từng CBTD cột A và cột I tại 2 Vùng: Vùng Thu nợ (A:F) và Vùng Giải ngân (I:N) rồi tự động điền vào sheet "Tong hop", đề nghị:

(1) Trong sheet "Tong hop", tại từng vùng liệt kê số liệu của từng CBTD sẽ lần lượt liệt kê số liệu từng tháng của từng CBTD, lần lượt hết T1 rồi đến T2 ==> không có ô trống tại các cột thể hiện phần Thu nợ (ví dụ vùng A7:F10 không có ô trống)
Riêng vùng Giải ngân thì lại có thể có ô trống, ví dụ vùng H7:L10 có dòng trống là dòng 9 ==> Mục đích là khi Filter theo tháng thì vẫn nhìn được chi tiết Thu nợ và Giải ngân trong từng tháng (ví dụ Filter ô A6 có thể nhìn số liệu từng tháng mà không sợ bị che mất dòng)

(2) Tại từng vùng liệt kê Thu nợ và Giải ngân trong sheet "Tong hop" sẽ sắp xếp các dòng dữ liệu theo chiều từ giá trị cao nhất xuống thấp nhất tương ứng với cột giá trị Thu nợ và giá trị Giải ngân (ví dụ cột F có 11>7>5 trong tháng 1, và cột L có 20>15) ==> Đề nghị (2) không quan trọng bằng đề nghị (1), nếu làm được (2) thì càng tốt!!!

Em cảm ơn các bác nhiều nhiều!!!
 

File đính kèm

  • Tim_kiem_&_Liet_ke (MOI).xlsx
    17.6 KB · Đọc: 8
Chào các bác trong GPE!

Em có 01 file làm ví dụ mong các Bác hỗ trợ!
Nhu cầu của em là Tìm kiếm dữ liệu trong các sheet "T1", "T2" và "T3" để lấy dữ liệu theo tên từng CBTD cột A và cột J tại 2 Vùng: Vùng Thu nợ (A:G) và Vùng Giải ngân (J:Q) rồi tự động điền vào sheet "Tong hop", đề nghị:

(1) Trong sheet "Tong hop", tại từng vùng liệt kê số liệu của từng CBTD sẽ lần lượt liệt kê số liệu từng tháng của từng CBTD, lần lượt hết T1 rồi đến T2 rồi đến T3 ==> không có ô trống tại các cột thể hiện phần Thu nợ. Riêng phần Giải ngân (trong sheet "Tong hop") thì lại có ô trống, của tháng nào thì hiện trong những dòng của tháng đó bên Thu nợ (ví dụ xem các cột AD đến AH ==> Mục đích là khi Filter theo tháng thì vẫn nhìn được chi tiết Thu nợ và Giải ngân trong từng tháng.

(2) Tại từng vùng liệt kê Thu nợ và Giải ngân trong sheet "Tong hop" sẽ sắp xếp các dòng dữ liệu theo chiều từ giá trị cao nhất xuống thấp nhất tương ứng với cột giá trị Thu nợ và giá trị Giải ngân (ví dụ cột AB và cột AH) ==> Đề nghị (2) không quan trọng bằng đề nghị (1), nếu làm được (2) thì càng tốt!!!

Em cảm ơn các bác nhiều nhiều!!!
Xem cách làm tuần tự từ sheet Bố_Trí sang phải rồi dùng PivotTable, kết quả xem sheet4.

A_TH.JPG
 

File đính kèm

  • Tim_kiem_&_Liet_ke (MOI).xlsx
    38.2 KB · Đọc: 7
Mình xin góp í với bạn ở khía cạnh xây dựng CSDL; Có thể bạn không vừa lòng sau khi đọc xong bài này:
1./ Bạn không nên xài tên NVTD viết tắc như trong file; Nên xài mã nhân viên theo qui luật sau:
PHP:
Mã NV  Ho & Tên CBTD
BTH00  Bùi Thị Thúy Hoa
DFT00  Dương Đức Tuấn
FDC00  Đào Từ  Duy Cường
NJH00  Nguyễn Hùng
NNH00  Nguyễn Ngọc Huyền
NTK00  Ngô Trọng Khác
THH00  Trần Thị Hải Hà
THH01  Từ Hàng Hải
. . ..    . . . . .

2./ Cũng tương tự như vậy, bạn nên thiết lập danh mục vay tương tự như ví dụ sau:
Mã:
Mã  Mục đích vay
CM  Chứng minh NLTC
GV  Góp vốn mua CP
Kh  Khác
KD  Kinh doanh
MN  Mua Nhà
TS  Mua TSCĐ
OT  Ô Tô
ST  STK
SN  Sửa Nhà
TC  Thấu Chi
TD  Tiêu dùng
Vy  Vay CBNV
 . . .  . . .

Một khi bạn thiết lập các bảng danh mục này thì trong khi vận hành CSDL sẽ giảm thiểu sai sót ngớ ngẩn, mà có khi khó tìm ra trong 1 sớm 1 chiều.

Tạm thời là vậy & rất vui nếu được tiếp tục trao đổi hay nghe fản bác từ bạn!
 
Chào các bác trong GPE!

Em có 01 file làm ví dụ mong các Bác hỗ trợ!
Nhu cầu của em là Tìm kiếm dữ liệu trong các sheet "T1", "T2" và "T3" để lấy dữ liệu theo tên từng CBTD cột A và cột J tại 2 Vùng: Vùng Thu nợ (A:G) và Vùng Giải ngân (J:Q) rồi tự động điền vào sheet "Tong hop", đề nghị:

(1) Trong sheet "Tong hop", tại từng vùng liệt kê số liệu của từng CBTD sẽ lần lượt liệt kê số liệu từng tháng của từng CBTD, lần lượt hết T1 rồi đến T2 rồi đến T3 ==> không có ô trống tại các cột thể hiện phần Thu nợ. Riêng phần Giải ngân (trong sheet "Tong hop") thì lại có ô trống, của tháng nào thì hiện trong những dòng của tháng đó bên Thu nợ (ví dụ xem các cột AD đến AH ==> Mục đích là khi Filter theo tháng thì vẫn nhìn được chi tiết Thu nợ và Giải ngân trong từng tháng.

(2) Tại từng vùng liệt kê Thu nợ và Giải ngân trong sheet "Tong hop" sẽ sắp xếp các dòng dữ liệu theo chiều từ giá trị cao nhất xuống thấp nhất tương ứng với cột giá trị Thu nợ và giá trị Giải ngân (ví dụ cột AB và cột AH) ==> Đề nghị (2) không quan trọng bằng đề nghị (1), nếu làm được (2) thì càng tốt!!!

Em cảm ơn các bác nhiều nhiều!!!
Mã:
Sub TongHop()
  Dim Sht As Worksheet
  Dim thuArr(), giaiArr(), Arr(), Res(), shArr()
  Dim i As Long, ik As Long, iR As Long, eR1 As Long, eR2 As Long
  Dim n As Long, j As Long, Col As Long
  Dim key As String
  Const fR = 6
  
  shArr = Array("T1", "T2")

  Set Sht = Sheets("Tong Hop")
  'Sht.AutoFilterMode = False
  Col = Sht.Range("AAA3").End(xlToLeft).Column
  Sht.Range("A7:A65500").Resize(, Col + 12).Clear

  With CreateObject("scripting.dictionary")
    For j = 2 To Col Step 13
      key = Sht.Cells(3, j).Value
      i = i + 1
      .Item(Sht.Cells(3, j).Value) = i
    Next j
    ReDim Res(1 To .Count, 1 To 4)

    For n = 0 To UBound(shArr)
      Set Sht = Sheets(shArr(n))
      
      eR1 = Sht.Range("A" & Rows.Count).End(xlUp).Row - fR
      If eR1 > 1 Then 'Xét Thu No
        thuArr = Sht.Range("A7:F7").Resize(eR1).Value
        ReDim Arr(1 To eR1, 1 To 6)
        For j = 1 To UBound(Res) 'ReDim Mang thu No
          Res(j, 1) = Arr 'Mang thu No
          Res(j, 2) = 0 'Thu tu dòng Mang thu No
        Next j
        For i = 1 To eR1
          key = thuArr(i, 1)
          If .exists(key) Then
            ik = .Item(key) 'Thu tu CBTD
            Res(ik, 2) = Res(ik, 2) + 1 'Thu tu dòng Mang thu No
            iR = Res(ik, 2)
            
            Res(ik, 1)(iR, 1) = shArr(n) 'gán giá tri
            For j = 2 To 6
              Res(ik, 1)(iR, j) = thuArr(i, j)
            Next j
          Else
            MsgBox (key & " khong có trong danh muc can bo tin dung")
          End If
        Next i
      End If
      
      eR2 = Sht.Range("I" & Rows.Count).End(xlUp).Row - fR
      If eR2 > 1 Then 'Xét Giai ngan
        giaiArr = Sht.Range("I7:N7").Resize(eR2).Value
        ReDim Arr(1 To eR2, 1 To 5)
        For j = 1 To UBound(Res) 'ReDim Mang Giai ngan
          Res(j, 3) = Arr 'Mang Giai ngan
          Res(j, 4) = 0 'Thu tu dòng Mang Giai ngan
        Next j
        For i = 1 To eR2
          key = giaiArr(i, 1)
          If .exists(key) Then
            ik = .Item(key) 'Thu tu CBTD
            Res(ik, 4) = Res(ik, 4) + 1 'Thu tu dòng Mang Giai ngan
            iR = Res(ik, 4)

            For j = 2 To 6
              Res(ik, 3)(iR, j - 1) = giaiArr(i, j)
            Next j
          Else
            MsgBox (key & " khong có trong danh muc can bo tin dung")
          End If
        Next i
      End If
      
      Set Sht = Sheets("Tong Hop")
      For j = 1 To UBound(Res)
        Col = (j - 1) * 13 + 1
        eR1 = Sht.Cells(Rows.Count, Col).End(xlUp).Row + 1
        If eR1 < 7 Then eR1 = 7
        If Res(j, 2) > 0 Then
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6) = Res(j, 1)
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6).Sort Sht.Cells(eR1, Col + 5).Resize(Res(j, 2)), 2, Header:=xlNo
        End If
        If Res(j, 4) > 0 Then
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5) = Res(j, 3)
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5).Sort Sht.Cells(eR1, Col + 11).Resize(Res(j, 4)), 2, Header:=xlNo
        End If
      Next j
    Next n
  End With
End Sub
 

File đính kèm

  • Tim_kiem_&_Liet_ke (MOI).xlsm
    2.8 MB · Đọc: 9
Cảm ơn các Bác đã nhiệt tình hỗ trợ!!

@be09: cảm ơn bác đã đưa ra bảng tổng hợp dễ hiểu như trong hình, tuy nhiên nhu cầu của em hơi khác! Về tổng hợp số liệu em đã tự làm được và em để ở sheet khác, nhu cầu của em chỉ là "Liệt Kê" trong sheet "Tong hop" chỉ là "Liệt kê" cơ học, không cần tính toán gì, để từng CBNV có thể Filter xem trong từng tháng thì mình Thu nợ và Giải ngân chi tiết KH nào với số tiền bao nhiêu!!

@Hoang2013: cảm ơn bác đã tư vấn, việc em chuẩn hóa tên gọi các định danh thì em đã chuẩn hóa "chuẩn" rồi bác ạh! bác có thể xem bài đầu tiên trên cùng trong thread, vì em cần làm ví dự đơn giản hơn, như lúc đầu bác @bomberman211 nói xem khó hiểu quá!! em đã viết ví dụ lại cho đơn giản hơn, nên cách đặt tên có thể chưa chuẩn hóa thì mong bác thông cảm, em sẽ rút kinh nghiệm!!

@HieuCD: cảm ơn bác đã viết những câu lệnh VBA công phu, chạy câu lệnh của bác đã giải quyết trọn vẹn nhu cầu của em, tuy nhiên:
- Em mù tịt về VBA, mong các bác đừng cười em, em xấu hổ :((
- Nhu cầu của em là cần "Tìm kiếm" trong 12 sheet tương ứng với 12 tháng để "Liệt kê" vào sheet "Tong hop" nên không rõ sẽ phải điều chỉnh câu lệnh của bác ntn cho tận 12 sheet thay vì hiện tại là 2 sheet (T1 và T2)
- Nhu cầu em đăng đàn chỉ là 1 vấn đề còn tồn tại cuối cùng để hoàn thiện nốt file Tổng hợp BC với rất nhiều nhu cầu khác nhau thì em đã done, chỉ còn lại vấn đề này, em viết hoàn toàn bằng các câu lệnh excel, hiện tại dung lượng của file em viết "*.xlsb" ~ 12MB chạy Excel 2013 ==> File này hoàn thành sẽ bàn giao cho bộ phận thống kê chỉ được cài đặt Excel 2007 ==> khi đó em phải convert từ file "*.xlsb" thành file "*.xlsx" ~ 20MB, khi đó cũng ko biết có chạy được Macro không hay nữa :((
==> Do đó nếu được em rất mong các bác chỉ cho em câu lệnh Hàm excel thì tốt quá!!
 
Cảm ơn các Bác đã nhiệt tình hỗ trợ!!

@be09: cảm ơn bác đã đưa ra bảng tổng hợp dễ hiểu như trong hình, tuy nhiên nhu cầu của em hơi khác! Về tổng hợp số liệu em đã tự làm được và em để ở sheet khác, nhu cầu của em chỉ là "Liệt Kê" trong sheet "Tong hop" chỉ là "Liệt kê" cơ học, không cần tính toán gì, để từng CBNV có thể Filter xem trong từng tháng thì mình Thu nợ và Giải ngân chi tiết KH nào với số tiền bao nhiêu!!

@Hoang2013: cảm ơn bác đã tư vấn, việc em chuẩn hóa tên gọi các định danh thì em đã chuẩn hóa "chuẩn" rồi bác ạh! bác có thể xem bài đầu tiên trên cùng trong thread, vì em cần làm ví dự đơn giản hơn, như lúc đầu bác @bomberman211 nói xem khó hiểu quá!! em đã viết ví dụ lại cho đơn giản hơn, nên cách đặt tên có thể chưa chuẩn hóa thì mong bác thông cảm, em sẽ rút kinh nghiệm!!

@HieuCD: cảm ơn bác đã viết những câu lệnh VBA công phu, chạy câu lệnh của bác đã giải quyết trọn vẹn nhu cầu của em, tuy nhiên:
- Em mù tịt về VBA, mong các bác đừng cười em, em xấu hổ :((
- Nhu cầu của em là cần "Tìm kiếm" trong 12 sheet tương ứng với 12 tháng để "Liệt kê" vào sheet "Tong hop" nên không rõ sẽ phải điều chỉnh câu lệnh của bác ntn cho tận 12 sheet thay vì hiện tại là 2 sheet (T1 và T2)
- Nhu cầu em đăng đàn chỉ là 1 vấn đề còn tồn tại cuối cùng để hoàn thiện nốt file Tổng hợp BC với rất nhiều nhu cầu khác nhau thì em đã done, chỉ còn lại vấn đề này, em viết hoàn toàn bằng các câu lệnh excel, hiện tại dung lượng của file em viết "*.xlsb" ~ 12MB chạy Excel 2013 ==> File này hoàn thành sẽ bàn giao cho bộ phận thống kê chỉ được cài đặt Excel 2007 ==> khi đó em phải convert từ file "*.xlsb" thành file "*.xlsx" ~ 20MB, khi đó cũng ko biết có chạy được Macro không hay nữa :((
==> Do đó nếu được em rất mong các bác chỉ cho em câu lệnh Hàm excel thì tốt quá!!
Có những sheet nào thì bạn liệt kê trong dòng lệnh:
shArr = Array("T1", "T2")
Bạn chạy code xong có kết quả, lưu lại rồi Save As thành .xlsx rồi gởi đi
File .xlsx không lưu được macro, nhưng có thể tạo 1 file lưu code và khi chạy sẽ gọi file .xlsx để xử lý. Tại sao bạn phải chuyển qua .xlsx, Excel 2007 đọc được .xlsb mà
Muốn dùng công thức thì phải lập bảng phụ
 
Cảm ơn các Bác đã nhiệt tình hỗ trợ!!

@be09: cảm ơn bác đã đưa ra bảng tổng hợp dễ hiểu như trong hình, tuy nhiên nhu cầu của em hơi khác! Về tổng hợp số liệu em đã tự làm được và em để ở sheet khác, nhu cầu của em chỉ là "Liệt Kê" trong sheet "Tong hop" chỉ là "Liệt kê" cơ học, không cần tính toán gì, để từng CBNV có thể Filter xem trong từng tháng thì mình Thu nợ và Giải ngân chi tiết KH nào với số tiền bao nhiêu!!
...............
- Nhu cầu của em là cần "Tìm kiếm" trong 12 sheet tương ứng với 12 tháng để "Liệt kê" vào sheet "Tong hop" nên không rõ sẽ phải điều chỉnh câu lệnh của bác ntn cho tận 12 sheet thay vì hiện tại là 2 sheet (T1 và T2)
- File này hoàn thành sẽ bàn giao cho bộ phận thống kê chỉ được cài đặt Excel 2007 ==> khi đó em phải convert từ file "*.xlsb" thành file "*.xlsx" ~ 20MB, khi đó cũng ko biết có chạy được Macro không hay nữa.
==> Do đó nếu được em rất mong các bác chỉ cho em câu lệnh Hàm excel thì tốt quá!!
Nếu có 12 tháng thì cách trên tôi chỉ thêm code gộp các Sheet vào sheet tổng và thêm code chạy ra PivotTable là có cái bảng trên.

Tại sao tôi thích làm theo kiểu cấu trúc trên để sử dụng PivotTable?
Nhất là đối với những người thường xuyên phải tổng hợp báo cáo và gặp xếp khó tính hay thay đổi nội dung, biểu mẫu báo cáo, thì PivotTable sẽ là cứu cánh, nó vô cùng linh hoạt có thể ứng biến, tổng hợp theo mọi nhu cầu báo cáo (chỉ cần rê, thả) là có kết quả, nếu biết VBA thì chỉ cần gán code cho mỗi nút 1 chức năng báo cáo chỉ việc nhấn nút là có ngay kết quả cần.
 
Lần chỉnh sửa cuối:
Có những sheet nào thì bạn liệt kê trong dòng lệnh:
shArr = Array("T1", "T2")
Bạn chạy code xong có kết quả, lưu lại rồi Save As thành .xlsx rồi gởi đi
File .xlsx không lưu được macro, nhưng có thể tạo 1 file lưu code và khi chạy sẽ gọi file .xlsx để xử lý. Tại sao bạn phải chuyển qua .xlsx, Excel 2007 đọc được .xlsb mà
Muốn dùng công thức thì phải lập bảng phụ

Em đã dùng thử chạy *.xlsb trên Excel 2007 nhưng bảng biểu thì bị mất hết đường kẻ viền bao quanh từng ô, màu sắc tô các ô thì bị mất hết chuyển sang màu trắng,... nói chung chạy cảm giác máy bị lag và báo lỗi!!
 
Nếu có 12 tháng thì cách trên tôi chỉ thêm code gộp các Sheet vào sheet tổng và thêm code chạy ra PivotTable là có cái bảng trên.

Tại sao tôi thích làm theo kiểu cấu trúc trên để sử dụng PivotTable?
Nhất là đối với những người thường xuyên phải tổng hợp báo cáo và gặp xếp khó tính hay thay đổi nội dung, biểu mẫu báo cáo, thì PivotTable sẽ là cứu cánh, nó vô cùng linh hoạt có thể ứng biến, tổng hợp theo mọi nhu cầu báo cáo (chỉ cần rê, thả) là có kết quả, nếu biết VBA thì chỉ cần gán code cho mỗi nút 1 chức năng báo cáo chỉ việc nhấn nút là có ngay kết quả cần.

Nhu cầu của em là sử dụng Hàm excel thì càng tốt để máy tính tự động ra kết quả và em chỉ việc copy từ file tính toán của em nặng ~20MB để paste value ra file raw ~ 1MB (mục đích chỉ là file text để gửi email đỡ tốn tài nguyên), sau khi làm được việc này thì em giao cho nhân viên của em chỉ có mỗi nghiệp vụ copy paste value và gửi đi mà thôi.

Cũng vì khổ nỗi nhân viên của em không biết tý gì về excel nên em muốn tối giản nhất thao tác, để bạn ý chỉ copy paste value, còn về phần em những việc chạy Pivot Table như bác hướng dẫn thì em cũng có kiến thức và tự làm được ạh!! (chỉ có mỗi VBA là em mù tịt thôi ạh!!)

Em thanks bác nhiều vì đã hỗ trợ!!
 
Em đã dùng thử chạy *.xlsb trên Excel 2007 nhưng bảng biểu thì bị mất hết đường kẻ viền bao quanh từng ô, màu sắc tô các ô thì bị mất hết chuyển sang màu trắng,... nói chung chạy cảm giác máy bị lag và báo lỗi!!
Chỉnh lại code không xóa định dạng và bớt giựt
Mã:
Sub TongHop()
  Dim Sht As Worksheet
  Dim thuArr(), giaiArr(), Arr(), Res(), shArr()
  Dim i As Long, ik As Long, iR As Long, eR1 As Long, eR2 As Long
  Dim n As Long, j As Long, Col As Long
  Dim key As String
  Const fR = 6
  
  shArr = Array("T1", "T2")
  
  Application.ScreenUpdating = False
  Set Sht = Sheets("Tong Hop")
  Col = Sht.Range("AAA3").End(xlToLeft).Column
  Sht.Range("A7:A65500").Resize(, Col + 12).ClearContents

  With CreateObject("scripting.dictionary")
    For j = 2 To Col Step 13
      key = Sht.Cells(3, j).Value
      i = i + 1
      .Item(Sht.Cells(3, j).Value) = i
    Next j
    ReDim Res(1 To .Count, 1 To 4)

    For n = 0 To UBound(shArr)
      Set Sht = Sheets(shArr(n))
      
      eR1 = Sht.Range("A" & Rows.Count).End(xlUp).Row - fR
      If eR1 > 1 Then 'Xét Thu No
        thuArr = Sht.Range("A7:F7").Resize(eR1).Value
        ReDim Arr(1 To eR1, 1 To 6)
        For j = 1 To UBound(Res) 'ReDim Mang thu No
          Res(j, 1) = Arr 'Mang thu No
          Res(j, 2) = 0 'Thu tu dòng Mang thu No
        Next j
        For i = 1 To eR1
          key = thuArr(i, 1)
          If .exists(key) Then
            ik = .Item(key) 'Thu tu CBTD
            Res(ik, 2) = Res(ik, 2) + 1 'Thu tu dòng Mang thu No
            iR = Res(ik, 2)
            
            Res(ik, 1)(iR, 1) = shArr(n) 'gán giá tri
            For j = 2 To 6
              Res(ik, 1)(iR, j) = thuArr(i, j)
            Next j
          Else
            MsgBox (key & " khong có trong danh muc can bo tin dung")
          End If
        Next i
      End If
      
      eR2 = Sht.Range("I" & Rows.Count).End(xlUp).Row - fR
      If eR2 > 1 Then 'Xét Giai ngan
        giaiArr = Sht.Range("I7:N7").Resize(eR2).Value
        ReDim Arr(1 To eR2, 1 To 5)
        For j = 1 To UBound(Res) 'ReDim Mang Giai ngan
          Res(j, 3) = Arr 'Mang Giai ngan
          Res(j, 4) = 0 'Thu tu dòng Mang Giai ngan
        Next j
        For i = 1 To eR2
          key = giaiArr(i, 1)
          If .exists(key) Then
            ik = .Item(key) 'Thu tu CBTD
            Res(ik, 4) = Res(ik, 4) + 1 'Thu tu dòng Mang Giai ngan
            iR = Res(ik, 4)

            For j = 2 To 6
              Res(ik, 3)(iR, j - 1) = giaiArr(i, j)
            Next j
          Else
            MsgBox (key & " khong có trong danh muc can bo tin dung")
          End If
        Next i
      End If
      
      Set Sht = Sheets("Tong Hop")
      For j = 1 To UBound(Res)
        Col = (j - 1) * 13 + 1
        eR1 = Sht.Cells(Rows.Count, Col).End(xlUp).Row + 1
        If eR1 < 7 Then eR1 = 7
        If Res(j, 2) > 0 Then
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6) = Res(j, 1)
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6).Sort Sht.Cells(eR1, Col + 5).Resize(Res(j, 2)), 2, Header:=xlNo
        End If
        If Res(j, 4) > 0 Then
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5) = Res(j, 3)
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5).Sort Sht.Cells(eR1, Col + 11).Resize(Res(j, 4)), 2, Header:=xlNo
        End If
      Next j
    Next n
  End With
  Application.ScreenUpdating = True
End Sub
Chạy code xong bạn làm gì thêm cũng được
Nhân viên của bạn copy từ đâu và Past tới đâu, nội dung gì
 
Xin chào bác @HieuCD

Em đã mầy mò theo câu lệnh VBA của bác, em đã chỉnh sửa theo hướng dẫn để ra được câu lệnh như file word đính kèm.
Tuy nhiên máy tính báo lỗi theo như file JPG đính kèm "xxxxxx khong co trong danh muc can bo tin dung" ==> em bị treo máy vì bấm Enter OK mãi mà không thoát được :((

Em thỉnh cầu bác nếu được bác xem giúp em file excel *.xlsb final của em chỉ còn chờ mỗi thao tác này là done, bác vui lòng download tại link:
https://drive.google.com/open?id=0B3jnsoNETp_hRHgzUVIxY0VjUEczR3VsZFZOMkl0SVdCaUdN ==> có 12 sheet được đặt tên từ T1, T2, .... đến T12, nhu cầu của em là "Tìm Kiếm" Dữ liệu tại từng sheet gồm VÙNG THU NỢ (BK:BR)VÙNG GIẢI NGÂN (N:U) để "Liệt Kê" (không cần tính toán mà chỉ đơn thuần là liệt kê) tại sheet "Tong Hop" trong vùng (I5:FS2005)

Em không biết có thể tạo 01 nút biểu tượng để mỗi lần cần chạy Macro (refresh) thì Nhân viên em chỉ cần click chuột cho dễ thao tác không bác nhỉ!!?

Em cảm ơn bác nhiều!!
 

File đính kèm

  • VBA.docx
    12.5 KB · Đọc: 3
  • Cau lenh VBA.jpg
    Cau lenh VBA.jpg
    224.4 KB · Đọc: 7
Xin chào bác @HieuCD

Em đã mầy mò theo câu lệnh VBA của bác, em đã chỉnh sửa theo hướng dẫn để ra được câu lệnh như file word đính kèm.
Tuy nhiên máy tính báo lỗi theo như file JPG đính kèm "xxxxxx khong co trong danh muc can bo tin dung" ==> em bị treo máy vì bấm Enter OK mãi mà không thoát được :((

Em thỉnh cầu bác nếu được bác xem giúp em file excel *.xlsb final của em chỉ còn chờ mỗi thao tác này là done, bác vui lòng download tại link:
https://drive.google.com/open?id=0B3jnsoNETp_hRHgzUVIxY0VjUEczR3VsZFZOMkl0SVdCaUdN ==> có 12 sheet được đặt tên từ T1, T2, .... đến T12, nhu cầu của em là "Tìm Kiếm" Dữ liệu tại từng sheet gồm VÙNG THU NỢ (BK:BR)VÙNG GIẢI NGÂN (N:U) để "Liệt Kê" (không cần tính toán mà chỉ đơn thuần là liệt kê) tại sheet "Tong Hop" trong vùng (I5:FS2005)

Em không biết có thể tạo 01 nút biểu tượng để mỗi lần cần chạy Macro (refresh) thì Nhân viên em chỉ cần click chuột cho dễ thao tác không bác nhỉ!!?

Em cảm ơn bác nhiều!!
Để tạo nút lệnh bạn chọn menu Insert, Shapes, sau đó click chuột phải và ...
Gởi file mới chỉnh code được
 
Xin chào bác @HieuCD


Em thỉnh cầu bác nếu được bác xem giúp em file excel *.xlsb final của em chỉ còn chờ mỗi thao tác này là done, bác vui lòng download tại link:
https://drive.google.com/open?id=0B3jnsoNETp_hRHgzUVIxY0VjUEczR3VsZFZOMkl0SVdCaUdN ==> có 12 sheet được đặt tên từ T1, T2, .... đến T12, nhu cầu của em là "Tìm Kiếm" Dữ liệu tại từng sheet gồm VÙNG THU NỢ (BK:BR)VÙNG GIẢI NGÂN (N:U) để "Liệt Kê" (không cần tính toán mà chỉ đơn thuần là liệt kê) tại sheet "Tong Hop" trong vùng (I5:FS2005)

Bạn gởi file Cty Nen mong Song Hong.xlsx để làm gì?

Em xin được edit lại:

Nhu cầu của em là Tìm kiếm dữ liệu trong các sheet "T1" và "T2" để lấy dữ liệu theo tên từng CBTD cột A và cột I tại 2 Vùng: Vùng Thu nợ (A:F) và Vùng Giải ngân (I:N) rồi tự động điền vào sheet "Tong hop", đề nghị:

(1) Trong sheet "Tong hop", tại từng vùng liệt kê số liệu của từng CBTD sẽ lần lượt liệt kê số liệu từng tháng của từng CBTD, lần lượt hết T1 rồi đến T2 ==> không có ô trống tại các cột thể hiện phần Thu nợ (ví dụ vùng A7:F10 không có ô trống)
Riêng vùng Giải ngân thì lại có thể có ô trống, ví dụ vùng H7:L10 có dòng trống là dòng 9 ==> Mục đích là khi Filter theo tháng thì vẫn nhìn được chi tiết Thu nợ và Giải ngân trong từng tháng (ví dụ Filter ô A6 có thể nhìn số liệu từng tháng mà không sợ bị che mất dòng)

(2) Tại từng vùng liệt kê Thu nợ và Giải ngân trong sheet "Tong hop" sẽ sắp xếp các dòng dữ liệu theo chiều từ giá trị cao nhất xuống thấp nhất tương ứng với cột giá trị Thu nợ và giá trị Giải ngân (ví dụ cột F có 11>7>5 trong tháng 1, và cột L có 20>15) ==> Đề nghị (2) không quan trọng bằng đề nghị (1), nếu làm được (2) thì càng tốt!!!

Em cảm ơn các bác nhiều nhiều!!!

Làm theo "Đề nghị: (1)"
Màu mè trang trí bạn tự làm, càng nhiều càng nặng file.
 

File đính kèm

  • Tim_kiem_&_Liet_ke (MOI).xlsb
    250.9 KB · Đọc: 13
Lần chỉnh sửa cuối:
Để tạo nút lệnh bạn chọn menu Insert, Shapes, sau đó click chuột phải và ...
Gởi file mới chỉnh code được
Qua nay em đi công tác không có máy tính nên reply hơi chậm mong các bác thông cảm!!

Hôm trước không hiểu sao lớ ngớ em lại gửi nhầm Link, em xin được gửi lại file BC em làm tại địa chỉ:
https://drive.google.com/open?id=1crOzdanGsH0AbokT5bJdmKRB6266BeSz

Kính nhờ bác @HieuCD và bác @Ba Tê hỗ trợ giúp em ạh!!

Em cảm ơn các bác nhiều!!
 
Qua nay em đi công tác không có máy tính nên reply hơi chậm mong các bác thông cảm!!

Hôm trước không hiểu sao lớ ngớ em lại gửi nhầm Link, em xin được gửi lại file BC em làm tại địa chỉ:
https://drive.google.com/open?id=1crOzdanGsH0AbokT5bJdmKRB6266BeSz

Kính nhờ bác @HieuCD và bác @Ba Tê hỗ trợ giúp em ạh!!

Em cảm ơn các bác nhiều!!
Lần sau gởi file sát thực tế ngay từ đầu để không làm mất thời gian người giúp bạn
Mã:
Sub TongHop()
  Dim Sht As Worksheet
  Dim nvArr(), thuArr(), giaiArr(), Arr(), Res(), shArr()
  Dim i As Long, ik As Long, iR As Long, eR1 As Long, eR2 As Long
  Dim n As Long, j As Long, Col As Long
  Dim key As String
  Const fC = 9
  Const fR = 8
  With Sheets("data")
    nvArr = .Range("B3:D" & .Range("B65500").End(xlUp).Row).Value
  End With
  shArr = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Set Sht = Sheets("Tong Hop")
  Col = Sht.Range("AAA1").End(xlToLeft).Column
  Sht.Range("A5:A65500").Resize(, Col + 12).ClearContents

  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nvArr)
      .Item(nvArr(i, 3)) = nvArr(i, 1)
    Next i
    For j = fC To Col Step 14
      n = n + 1
      .Item(.Item(Sht.Cells(1, j).Value)) = n     
    Next j
    ReDim Res(1 To n, 1 To 4)

    For n = 0 To UBound(shArr)
      Set Sht = Sheets(shArr(n))
     
      eR1 = Sht.Range("BQ" & Rows.Count).End(xlUp).Row - fR
      If eR1 > 1 Then 'Xét Thu No
        thuArr = Sht.Range("BM9:BR9").Resize(eR1).Value
        ReDim Arr(1 To eR1, 1 To 6)
        For j = 1 To UBound(Res) 'ReDim Mang thu No
          Res(j, 1) = Arr 'Mang thu No
          Res(j, 2) = 0 'Thu tu dòng Mang thu No
        Next j
        For i = 1 To eR1
          key = thuArr(i, 5)
          If .exists(key) Then
            If TypeName(thuArr(i, 6)) = "Double" Then
              ik = .Item(key) 'Thu tu CBTD
              Res(ik, 2) = Res(ik, 2) + 1 'Thu tu dòng Mang thu No
              iR = Res(ik, 2)
              Res(ik, 1)(iR, 1) = shArr(n) 'Thang
              For j = 1 To 4
                Res(ik, 1)(iR, j + 1) = CStr(thuArr(i, j))
              Next j
              Res(ik, 1)(iR, 6) = thuArr(i, 6)
            End If
          Else
            If Not .exists("#" & key & "#") Then 'Khong muon hien canh báo thì bo 4 dòng này
              MsgBox (key & " khong có trong danh muc can bo tin dung")
              .Add "#" & key & "#", ""
            End If
          End If
        Next i
      End If
     
      eR2 = Sht.Range("T" & Rows.Count).End(xlUp).Row - fR
      If eR2 > 1 Then 'Xét Giai ngan
        giaiArr = Sht.Range("P9:U9").Resize(eR2).Value
        ReDim Arr(1 To eR2, 1 To 5)
        For j = 1 To UBound(Res) 'ReDim Mang Giai ngan
          Res(j, 3) = Arr 'Mang Giai ngan
          Res(j, 4) = 0 'Thu tu dòng Mang Giai ngan
        Next j
        For i = 1 To eR2
          key = giaiArr(i, 5)
          If .exists(key) Then
            If TypeName(giaiArr(i, 6)) = "Double" Then
              ik = .Item(key) 'Thu tu CBTD
              Res(ik, 4) = Res(ik, 4) + 1 'Thu tu dòng Mang Giai ngan
              iR = Res(ik, 4)
              For j = 1 To 4
                Res(ik, 3)(iR, j) = CStr(giaiArr(i, j))
              Next j
              Res(ik, 3)(iR, 5) = giaiArr(i, 6)
            End If
          Else
            If Not .exists("#" & key & "#") Then 'Khong muon hien canh báo thì bo 4 dòng này
              MsgBox (key & " khong có trong danh muc can bo tin dung")
              .Add "#" & key & "#", ""
            End If
          End If
        Next i
      End If
     
      Set Sht = Sheets("Tong Hop")
      For j = 1 To UBound(Res)
        Col = (j - 1) * 14 + fC
        eR1 = Sht.Cells(Rows.Count, Col).End(xlUp).Row + 1
        If eR1 < 5 Then eR1 = 5
        If Res(j, 2) > 0 Then
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6) = Res(j, 1)
          Sht.Cells(eR1, Col).Resize(Res(j, 2), 6).Sort Sht.Cells(eR1, Col + 5).Resize(Res(j, 2)), 2, Header:=xlNo
        End If
        If Res(j, 4) > 0 Then
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5) = Res(j, 3)
          Sht.Cells(eR1, Col + 7).Resize(Res(j, 4), 5).Sort Sht.Cells(eR1, Col + 11).Resize(Res(j, 4)), 2, Header:=xlNo
        End If
      Next j
    Next n
  End With
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub
 
Lần chỉnh sửa cuối:
Qua nay em đi công tác không có máy tính nên reply hơi chậm mong các bác thông cảm!!

Hôm trước không hiểu sao lớ ngớ em lại gửi nhầm Link, em xin được gửi lại file BC em làm tại địa chỉ:
https://drive.google.com/open?id=1crOzdanGsH0AbokT5bJdmKRB6266BeSz

Kính nhờ bác @HieuCD và bác @Ba Tê hỗ trợ giúp em ạh!!

Em cảm ơn các bác nhiều!!

Sau khi gởi file tôi thường tải lại xem file mình gởi có đúng là file "mới nhất" mình muốn gởi không.
Tôn trọng người khác cũng là tôn trọng mình!

Dùng Mã Nhân viên ai lại dùng Tên NV.
Chỉnh lại code bài #17:
PHP:
Option Explicit

Public Sub GPE()
Application.ScreenUpdating = False
Dim Ws As Worksheet, sArr(1 To 10000, 1 To 15), tArr(), dArr(), Tem As String, ShName As String, CbTD As String
Dim C As Long, i As Long, j As Long, K As Long, K2 As Long, n As Long, R As Long, Col As Long
'------------------------------Gom 12 sheet vao 1 mang sArr()'
For n = 1 To 12
    ShName = "T" & n
    With Sheets(ShName)
        tArr = .Range("P9:BR2000").Value
        R = UBound(tArr)
            For i = 1 To R
                If tArr(i, 3) <> "" Or tArr(i, 52) <> "" Then
                    K = K + 1
                    For j = 1 To 6
                        sArr(K, j) = tArr(i, j)
                        sArr(K, j + 6) = tArr(i, j + 49)
                    Next j
                    sArr(K, 13) = ShName
                End If
            Next i
    End With
    K = K + 1
Next n
R = K
'--------------------------------Lay du lieu theo tung Can bo Tin dung'
With Sheets("Tong Hop")
    Col = .Range("XFD1").End(xlToLeft).Column
    .Range("I5").Resize(1000, Col + 12).ClearContents
    For C = 9 To Col Step 14
        ReDim dArr(1 To 2000, 1 To 12)
        CbTD = .Cells(1, C).Value
        K = 0: K2 = 0
        For i = 1 To R
                If sArr(i, 13) = Empty Then K2 = K
            If sArr(i, 11) = CbTD And sArr(i, 12) <> "" Then
                K = K + 1
                dArr(K, 1) = sArr(i, 13)
                For j = 7 To 10
                    dArr(K, j - 5) = sArr(i, j)
                Next j
                dArr(K, 6) = sArr(i, 12)
            End If
            If sArr(i, 5) = CbTD And sArr(i, 6) <> "" Then
                K2 = K2 + 1
                For j = 1 To 4
                    dArr(K2, j + 7) = sArr(i, j)
                Next j
                dArr(K2, 12) = sArr(i, 6)
            End If
        Next i
        If K Then .Cells(5, C).Resize(K, 12) = dArr
    Next C
End With
End Sub
 

File đính kèm

  • 01.BC TONG THE-KHCN-VBA2.rar
    4.9 MB · Đọc: 3
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom