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

phanmoi688
[Xin nhờ giúp đỡ] Tìm cách xóa các ký tự trắng trong biểu
Trả lời
0
Đọc
1
phanmoi688
phanmoi688
V
Tìm điều kiện sau đó tính tổng ma hang theo điều kiện
Trả lời
0
Đọc
1
vnproc
V
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
26
Đọc
340
phanmoi688
phanmoi688
V
  • Question
Tìm kiếm và copy giá trị từ bảng đến bảng khác
Trả lời
8
Đọc
168
vnproc
V
N
Em cần giúp tách số thập phân trong chuỗi trên file excel
Trả lời
3
Đọc
45
Duy Tùng 9x
Duy Tùng 9x
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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