Tìm kiếm và tính tổng với VBA

Liên hệ QC
Masu1991

Masu1991

Thành viên hoạt động
Tham gia
21/3/20
Bài viết
110
Được thích
14
Mình có file dữ liệu như thế này, nhờ anh chị giúp đo
1/ Tìm tên MAU1 (ô C3) duy nhất (bỏ dữu liệu trùng) tương ứng với từng LINE ở sheet PLAN
2/ Tính tổng theo tuần dựa vào LINE, MAU1 và tuần (*) (ô F1)
(*) Ô f2 là số ngày để xác định số khoản cách ngày giữa 1 tuần VD: từ ngày 03/29 – 04/05 là 6 ngày (loại bỏ ngày chủ nhật và ngày lễ) vậy nên cần tính tổng cho Ô F3 là từ ngày 03/29 đến ngày 04/03 từ dữ liệu ở sheet PLAN.
Xin cảm ơn.
 

File đính kèm

  • TÌM KIẾM VÀ TÍNH TỔNG.xls
    138.5 KB · Đọc: 11
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Masu1991 đã viết:
Mình có file dữ liệu như thế này, nhờ anh chị giúp đo
1/ Tìm tên MAU1 (ô C3) duy nhất (bỏ dữu liệu trùng) tương ứng với từng LINE ở sheet PLAN
2/ Tính tổng theo tuần dựa vào LINE, MAU1 và tuần (*) (ô F1)
(*) Ô f2 là số ngày để xác định số khoản cách ngày giữa 1 tuần VD: từ ngày 03/29 – 04/05 là 6 ngày (loại bỏ ngày chủ nhật và ngày lễ) vậy nên cần tính tổng cho Ô F3 là từ ngày 03/29 đến ngày 04/03 từ dữ liệu ở sheet PLAN.
Xin cảm ơn.
Nhấp chuột vào đây để mở rộng...
1/ Tìm tên MAU1 (ô C3) duy nhất (bỏ dữu liệu trùng) tương ứng với từng LINE ở sheet PLAN:Nhập tay kết quả LINE1 và 2 gởi lên
 
Upvote 0
Masu1991 đã viết:
em gửi lại ạ, phiền anh hỗ trợ em. cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Sheet kết quả đã có dòng 1:2 và cột A:B
Dòng ngày của bạn sai các cột cuối, đã chỉnh lại
Chạy code
Mã: 
Option Explicit

Sub tinhtong()
  Dim sArr(), Mau(), SL(), aMau(), aSL(), dic As Object
  Dim eRow&, eCol&, sLine&, sRow&, sCol&, i&, iR&, j&, jC&, n&
  Dim fDay As Date, iKey$, iMax, slMax#
  Const dRow& = 22:  Const fRow& = 3
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("ANALYSIS ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row 'Dong cuoi
    eCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'Cot cuoi
    sLine = Int(eRow / 22) 'So Line

    ReDim aMau(1 To sLine):       ReDim aSL(1 To sLine)
    ReDim Mau(1 To 21, 1 To 1):   ReDim SL(1 To 21, 1 To eCol - 5)
    For n = 1 To sLine
      dic.Item(.Cells(fRow + (n - 1) * dRow, "B").Value) = n
      aMau(n) = Mau: aSL(n) = SL
    Next n
    For j = 6 To eCol
      jC = jC + 1
      fDay = .Cells(1, j).Value
      For i = 0 To 6
        dic.Item(Format(fDay + i, "ddmmyy")) = jC
      Next i
    Next j
  End With
 
  With Sheets("PLAN")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    eCol = .Cells(2, Columns.Count).End(xlToLeft).Column
    sArr = .Range("B2", .Cells(eRow, eCol)).Value
  End With
 
  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  For j = 3 To sCol
    sArr(1, j) = dic.Item(Format(sArr(1, j), "ddmmyy")) 'Thu tu cot mang SL
  Next j
  For i = 2 To sRow
    n = dic.Item(sArr(i, 1))
    iKey = sArr(i, 1) & "|" & sArr(i, 2)
    If dic.exists(iKey) = False Then
      iR = aMau(n)(21, 1) + 1 'Thu tu dong
      dic.Add iKey, iR
      aMau(n)(iR, 1) = sArr(i, 2)
      aMau(n)(21, 1) = iR
    End If
    iR = dic.Item(iKey)
    For j = 3 To sCol
      jC = sArr(1, j)
      If jC > 0 Then
        If sArr(i, j) <> Empty Then
          aSL(n)(iR, jC) = aSL(n)(iR, jC) + sArr(i, j)
        End If
      End If
    Next j
  Next i
 
  With Sheets("ANALYSIS ")
    sCol = UBound(SL, 2)
    For n = 1 To sLine
      iR = fRow + (n - 1) * dRow
      .Cells(iR, "c").Resize(20) = aMau(n)
      .Cells(iR, "F").Resize(20, sCol) = aSL(n)
      
      'Tinh dong Tieu Chuan Tuan
      sRow = aMau(n)(21, 1)
      For j = 1 To sCol
        iMax = Empty: slMax = 0
        For i = 1 To sRow
          If aSL(n)(i, j) <> Empty Then
            If slMax < aSL(n)(i, j) Then
              slMax = aSL(n)(i, j)
              iMax = .Cells(iR + i - 1, "E")
            End If
          End If
        Next i
        .Cells(iR + 20, 5 + j) = iMax
      Next j
    Next n
  End With
End Sub
 

File đính kèm

  • TÌM KIẾM VÀ TÍNH TỔNG (1).xlsm
    121.6 KB · Đọc: 24
Upvote 0
HieuCD đã viết:
Sheet kết quả đã có dòng 1:2 và cột A:B
Dòng ngày của bạn sai các cột cuối, đã chỉnh lại
Chạy code
Mã: 
Option Explicit

Sub tinhtong()
  Dim sArr(), Mau(), SL(), aMau(), aSL(), dic As Object
  Dim eRow&, eCol&, sLine&, sRow&, sCol&, i&, iR&, j&, jC&, n&
  Dim fDay As Date, iKey$, iMax, slMax#
  Const dRow& = 22:  Const fRow& = 3

  Set dic = CreateObject("scripting.dictionary")
  With Sheets("ANALYSIS ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row 'Dong cuoi
    eCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'Cot cuoi
    sLine = Int(eRow / 22) 'So Line

    ReDim aMau(1 To sLine):       ReDim aSL(1 To sLine)
    ReDim Mau(1 To 21, 1 To 1):   ReDim SL(1 To 21, 1 To eCol - 5)
    For n = 1 To sLine
      dic.Item(.Cells(fRow + (n - 1) * dRow, "B").Value) = n
      aMau(n) = Mau: aSL(n) = SL
    Next n
    For j = 6 To eCol
      jC = jC + 1
      fDay = .Cells(1, j).Value
      For i = 0 To 6
        dic.Item(Format(fDay + i, "ddmmyy")) = jC
      Next i
    Next j
  End With

  With Sheets("PLAN")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    eCol = .Cells(2, Columns.Count).End(xlToLeft).Column
    sArr = .Range("B2", .Cells(eRow, eCol)).Value
  End With

  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  For j = 3 To sCol
    sArr(1, j) = dic.Item(Format(sArr(1, j), "ddmmyy")) 'Thu tu cot mang SL
  Next j
  For i = 2 To sRow
    n = dic.Item(sArr(i, 1))
    iKey = sArr(i, 1) & "|" & sArr(i, 2)
    If dic.exists(iKey) = False Then
      iR = aMau(n)(21, 1) + 1 'Thu tu dong
      dic.Add iKey, iR
      aMau(n)(iR, 1) = sArr(i, 2)
      aMau(n)(21, 1) = iR
    End If
    iR = dic.Item(iKey)
    For j = 3 To sCol
      jC = sArr(1, j)
      If jC > 0 Then
        If sArr(i, j) <> Empty Then
          aSL(n)(iR, jC) = aSL(n)(iR, jC) + sArr(i, j)
        End If
      End If
    Next j
  Next i

  With Sheets("ANALYSIS ")
    sCol = UBound(SL, 2)
    For n = 1 To sLine
      iR = fRow + (n - 1) * dRow
      .Cells(iR, "c").Resize(20) = aMau(n)
      .Cells(iR, "F").Resize(20, sCol) = aSL(n)
     
      'Tinh dong Tieu Chuan Tuan
      sRow = aMau(n)(21, 1)
      For j = 1 To sCol
        iMax = Empty: slMax = 0
        For i = 1 To sRow
          If aSL(n)(i, j) <> Empty Then
            If slMax < aSL(n)(i, j) Then
              slMax = aSL(n)(i, j)
              iMax = .Cells(iR + i - 1, "E")
            End If
          End If
        Next i
        .Cells(iR + 20, 5 + j) = iMax
      Next j
    Next n
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh nhiều.
 
Upvote 0
HieuCD đã viết:
Sheet kết quả đã có dòng 1:2 và cột A:B
Dòng ngày của bạn sai các cột cuối, đã chỉnh lại
Chạy code
Mã: 
Option Explicit

Sub tinhtong()
  Dim sArr(), Mau(), SL(), aMau(), aSL(), dic As Object
  Dim eRow&, eCol&, sLine&, sRow&, sCol&, i&, iR&, j&, jC&, n&
  Dim fDay As Date, iKey$, iMax, slMax#
  Const dRow& = 22:  Const fRow& = 3

  Set dic = CreateObject("scripting.dictionary")
  With Sheets("ANALYSIS ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row 'Dong cuoi
    eCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'Cot cuoi
    sLine = Int(eRow / 22) 'So Line

    ReDim aMau(1 To sLine):       ReDim aSL(1 To sLine)
    ReDim Mau(1 To 21, 1 To 1):   ReDim SL(1 To 21, 1 To eCol - 5)
    For n = 1 To sLine
      dic.Item(.Cells(fRow + (n - 1) * dRow, "B").Value) = n
      aMau(n) = Mau: aSL(n) = SL
    Next n
    For j = 6 To eCol
      jC = jC + 1
      fDay = .Cells(1, j).Value
      For i = 0 To 6
        dic.Item(Format(fDay + i, "ddmmyy")) = jC
      Next i
    Next j
  End With

  With Sheets("PLAN")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    eCol = .Cells(2, Columns.Count).End(xlToLeft).Column
    sArr = .Range("B2", .Cells(eRow, eCol)).Value
  End With

  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  For j = 3 To sCol
    sArr(1, j) = dic.Item(Format(sArr(1, j), "ddmmyy")) 'Thu tu cot mang SL
  Next j
  For i = 2 To sRow
    n = dic.Item(sArr(i, 1))
    iKey = sArr(i, 1) & "|" & sArr(i, 2)
    If dic.exists(iKey) = False Then
      iR = aMau(n)(21, 1) + 1 'Thu tu dong
      dic.Add iKey, iR
      aMau(n)(iR, 1) = sArr(i, 2)
      aMau(n)(21, 1) = iR
    End If
    iR = dic.Item(iKey)
    For j = 3 To sCol
      jC = sArr(1, j)
      If jC > 0 Then
        If sArr(i, j) <> Empty Then
          aSL(n)(iR, jC) = aSL(n)(iR, jC) + sArr(i, j)
        End If
      End If
    Next j
  Next i

  With Sheets("ANALYSIS ")
    sCol = UBound(SL, 2)
    For n = 1 To sLine
      iR = fRow + (n - 1) * dRow
      .Cells(iR, "c").Resize(20) = aMau(n)
      .Cells(iR, "F").Resize(20, sCol) = aSL(n)
     
      'Tinh dong Tieu Chuan Tuan
      sRow = aMau(n)(21, 1)
      For j = 1 To sCol
        iMax = Empty: slMax = 0
        For i = 1 To sRow
          If aSL(n)(i, j) <> Empty Then
            If slMax < aSL(n)(i, j) Then
              slMax = aSL(n)(i, j)
              iMax = .Cells(iR + i - 1, "E")
            End If
          End If
        Next i
        .Cells(iR + 20, 5 + j) = iMax
      Next j
    Next n
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
chào anh, ở dòng tính tiêu chuẩn a sửa lại theo 2 điều kiện dưới giúp e với. hiện tại có sự thay đổi về tiêu chuẩn á anh. cảm ơn anh
- So sánh trong cột số lượng mỗi ngày, số lượng nào có số tiêu chuẩn lớn nhất thì trả về tiêu chuẩn đó.
- Nếu 2 số ở cột ngày bằng nhau thì lấy số tiêu chuẩn lớn nhất.
 
Upvote 0
Masu1991 đã viết:
chào anh, ở dòng tính tiêu chuẩn a sửa lại theo 2 điều kiện dưới giúp e với. hiện tại có sự thay đổi về tiêu chuẩn á anh. cảm ơn anh
- So sánh trong cột số lượng mỗi ngày, số lượng nào có số tiêu chuẩn lớn nhất thì trả về tiêu chuẩn đó.
- Nếu 2 số ở cột ngày bằng nhau thì lấy số tiêu chuẩn lớn nhất.
Nhấp chuột vào đây để mở rộng...
Bạn cho ví dụ với số liệu minh họa cụ thể
 
Upvote 0
Masu1991 đã viết:
Dạ, ví dụ là như thế này anh (ở những ô màu đỏ và ô màu xanh).
Nhấp chuột vào đây để mở rộng...
Masu1991 đã viết:
Dạ, ví dụ là như thế này anh (ở những ô màu đỏ và ô màu xanh).
Nhấp chuột vào đây để mở rộng...
Chỉnh code theo ví dụ
Mã: 
Option Explicit

Sub tinhtong()
  Dim sArr(), Mau(), SL(), aMau(), aSL(), dic As Object
  Dim eRow&, eCol&, sLine&, sRow&, sCol&, i&, iR&, j&, jC&, n&
  Dim fDay As Date, iKey$, iMax
  Const dRow& = 22:  Const fRow& = 3
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("ANALYSIS ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row 'Dong cuoi
    eCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'Cot cuoi
    sLine = Int(eRow / 22) 'So Line

    ReDim aMau(1 To sLine):       ReDim aSL(1 To sLine)
    ReDim Mau(1 To 21, 1 To 1):   ReDim SL(1 To 21, 1 To eCol - 5)
    For n = 1 To sLine
      dic.Item(.Cells(fRow + (n - 1) * dRow, "B").Value) = n
      aMau(n) = Mau: aSL(n) = SL
    Next n
    For j = 6 To eCol
      jC = jC + 1
      fDay = .Cells(1, j).Value
      For i = 0 To 6
        dic.Item(Format(fDay + i, "ddmmyy")) = jC
      Next i
    Next j
  End With
 
  With Sheets("PLAN")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    eCol = .Cells(2, Columns.Count).End(xlToLeft).Column
    sArr = .Range("B2", .Cells(eRow, eCol)).Value
  End With
 
  sRow = UBound(sArr):      sCol = UBound(sArr, 2)
  For j = 3 To sCol
    sArr(1, j) = dic.Item(Format(sArr(1, j), "ddmmyy")) 'Thu tu cot mang SL
  Next j
  For i = 2 To sRow
    n = dic.Item(sArr(i, 1))
    iKey = sArr(i, 1) & "|" & sArr(i, 2)
    If dic.exists(iKey) = False Then
      iR = aMau(n)(21, 1) + 1 'Thu tu dong
      dic.Add iKey, iR
      aMau(n)(iR, 1) = sArr(i, 2)
      aMau(n)(21, 1) = iR
    End If
    iR = dic.Item(iKey)
    For j = 3 To sCol
      jC = sArr(1, j)
      If jC > 0 Then
        If sArr(i, j) <> Empty Then
          aSL(n)(iR, jC) = aSL(n)(iR, jC) + sArr(i, j)
        End If
      End If
    Next j
  Next i
 
  With Sheets("ANALYSIS ")
    sCol = UBound(SL, 2)
    For n = 1 To sLine
      iR = fRow + (n - 1) * dRow
      .Cells(iR, "c").Resize(20) = aMau(n)
      .Cells(iR, "F").Resize(20, sCol) = aSL(n)
      
      'Tinh dong Tieu Chuan Tuan
      sRow = aMau(n)(21, 1)
      For j = 1 To sCol
        iMax = Empty
        For i = 1 To sRow
          If aSL(n)(i, j) <> Empty Then
            If iMax < .Cells(iR + i - 1, "E") Then
              iMax = .Cells(iR + i - 1, "E")
            End If
          End If
        Next i
        .Cells(iR + 20, 5 + j) = iMax
      Next j
    Next n
  End With
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
H
C
Chia sẻ: Kết quả xổ số Keno
    • Thích
    • Cười
Trả lời
7
Đọc
182
bebo021999
B
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
25
Đọc
491
bebo021999
B
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
4
Đọc
60
Hoàng Tuấn 868
H
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
3
Đọc
96
batista911
B
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
12
Đọc
215
ptm0412
ptm0412
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
1
Đọc
74
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
5
Đọc
141
kimtanmap
kimtanmap
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
1
Đọc
70
hoangtuaotrang_hp_vn
H
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
39
huynhnhu1234
huynhnhu1234
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
122
tranvansau278
T
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
111
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
156
zarra
zarra
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
290
anhdepjai
A
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
20K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
302
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
284
ptm0412
ptm0412
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
65
hoangminhtien
hoangminhtien
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

Back
Top Bottom