Tổng hợp dữ liệu theo điều kiện

[BuiQuangThuan]

Gửi các anh chị. Em có file đính kèm. Muốn nhờ anh chị thầy cô chỉ giúp.
Em có nghĩ đến việc sử dụng Dic. Nhưng nó vẫn không ra kết quả theo ý em muốn
Kết quả mong muốn em cũng đã để trong file.
Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

 

[leonguyenz]

Gửi các anh chị. Em có file đính kèm. Muốn nhờ anh chị thầy cô chỉ giúp.
Em có nghĩ đến việc sử dụng Dic. Nhưng nó vẫn không ra kết quả theo ý em muốn
Kết quả mong muốn em cũng đã để trong file.
Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

Cột H và I không phù hợp:
- Code SD "d1" có tên là "a2" và "a3", kết quả tên "a1" là không hợp lý, tương tự "d2"
- Tương tự với mail.
Cột K (thanh toán) căn cứ ở đâu? Tổng tiền 2,450,000 nhưng thanh toán 245,000?
Phần "DẾM" là đếm theo cột Code SD?

 

[CHAOQUAY]

Gửi các anh chị. Em có file đính kèm. Muốn nhờ anh chị thầy cô chỉ giúp.
Em có nghĩ đến việc sử dụng Dic. Nhưng nó vẫn không ra kết quả theo ý em muốn
Kết quả mong muốn em cũng đã để trong file.
Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

Bạn muốn tổng hợp theo cột E?
Nếu tổng hợp theo cột E, các cột tên, mail, code KH sau khi tổng hợp sẽ thế nào? Giữ nguyên hay là thay đổi?

File giả định bạn nên thêm vài chục mẫu nữa cho dễ hiểu

 

[BuiQuangThuan]

Cột H và I không phù hợp:
- Code SD "d1" có tên là "a2" và "a3", kết quả tên "a1" là không hợp lý, tương tự "d2"
- Tương tự với mail.
Cột K (thanh toán) căn cứ ở đâu? Tổng tiền 2,450,000 nhưng thanh toán 245,000?
Phần "DẾM" là đếm theo cột Code SD?

Cảm ơn anh Thầy @leonguyenz đã phản hồi ạ.
bài này là do 1 người bạn em nhờ giúp. em cũng đã sử dụng dic nhưng không ra kết quả
Phần "Code SD" sẽ dựa theo Code KH ạ: tức là nếu Code SD là d1-> nó chính là code KH
còn cột K thanh toán chính là 10% của cột tổng tiền ạ
Đếm chính là đếm theo cột Code SD như anh nói ạ

Bài đã được tự động gộp: 24/9/19

Bạn muốn tổng hợp theo cột E?
Nếu tổng hợp theo cột E, các cột tên, mail, code KH sau khi tổng hợp sẽ thế nào? Giữ nguyên hay là thay đổi?

File giả định bạn nên thêm vài chục mẫu nữa cho dễ hiểu

vâng. em sẽ thêm dữ liệu vào để dễ hình dung ạ

 

[leonguyenz]

bài này là do 1 người bạn em nhờ giúp. em cũng đã sử dụng dic nhưng không ra kết quả
Phần "Code SD" sẽ dựa theo Code KH ạ: tức là nếu Code SD là d1-> nó chính là code KH
còn cột K thanh toán chính là 10% của cột tổng tiền ạ
Đếm chính là đếm theo cột Code SD như anh nói ạ

Nếu sử dụng Dic, tham khảo code như sau, lưu ý code sau chỉ trả về kết quả 3 cột dữ liệu

Sub TongHopDL()
Dim sAr As Variant, i As Long, rAr As Variant
Dim Dic As Object, k As Long, Tmp As String
sAr = Sheet1.Range("A3:E" & Sheet1.Range("A65535").End(xlUp).Row).Value
ReDim rAr(1 To UBound(sAr, 1), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
Sheet1.Range("O3:Q100").ClearContents
For i = 1 To UBound(sAr, 1)
    Tmp = sAr(i, 5)
    If Tmp <> "" Then
        If Not Dic.Exists(Tmp) Then
            k = k + 1: Dic.Add Tmp, k
            rAr(k, 1) = sAr(i, 3)
            rAr(k, 2) = 1: rAr(k, 3) = Tmp
        Else
            rAr(Dic.Item(Tmp), 2) = rAr(Dic.Item(Tmp), 2) + 1
            rAr(Dic.Item(Tmp), 1) = rAr(Dic.Item(Tmp), 1) + sAr(i, 3)
        End If
    End If
Next i
If k Then Sheet1.Range("O3").Resize(k, 3) = rAr
End Sub

 

[Ba Tê]

Gửi các anh chị. Em có file đính kèm. Muốn nhờ anh chị thầy cô chỉ giúp.
Em có nghĩ đến việc sử dụng Dic. Nhưng nó vẫn không ra kết quả theo ý em muốn
Kết quả mong muốn em cũng đã để trong file.
Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

Viết code chỉ để ra "giống" kết quả mẫu chứ không chắc là đúng yêu cầu.

Option Explicit


Public Sub sGpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Txt1 As String, Txt2 As String
With CreateObject("Scripting.Dictionary")
    sArr = Range("A3", Range("A100000").End(xlUp)).Resize(, 5).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 6)
    For I = 1 To R
        Txt1 = sArr(I, 4) & "#"
        .Item(Txt1) = I
    Next I
    For I = 1 To R
        If sArr(I, 5) <> Empty Then
            Txt2 = sArr(I, 5)
            Txt1 = Txt2 & "#"
            If Not .Exists(Txt2) Then
                K = K + 1
                .Item(Txt2) = K
                dArr(K, 3) = sArr(I, 3)
                dArr(K, 4) = sArr(I, 3) * 0.1
                dArr(K, 5) = 1
                dArr(K, 6) = sArr(I, 5)
                If .Exists(Txt1) Then
                    dArr(K, 1) = sArr(.Item(Txt1), 1)
                    dArr(K, 2) = sArr(.Item(Txt1), 2)
                End If
            Else
                Rws = .Item(Txt2)
                dArr(Rws, 3) = dArr(Rws, 3) + sArr(I, 3)
                dArr(Rws, 4) = dArr(Rws, 4) + sArr(I, 3) * 0.1
                dArr(Rws, 5) = dArr(Rws, 5) + 1
            End If
        End If
    Next I
End With
    Range("H8").Resize(10000, 6).ClearContents
    If K Then Range("H8").Resize(K, 6) = dArr
End Sub

 

[VetMini]

...Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

50% kỹ năng làm việc là diễn giải.
Về sau này bạn lên làm sếp thì cũng phải diễn lại cho nhân viên.
Thảo nào ở đây cái câu "sếp quăng cho mớ việc, bắt làm mà chẳng giải thích..." nó xảy ra thường nhật.

 

[BuiQuangThuan]

50% kỹ năng làm việc là diễn giải.
Về sau này bạn lên làm sếp thì cũng phải diễn lại cho nhân viên.
Thảo nào ở đây cái câu "sếp quăng cho mớ việc, bắt làm mà chẳng giải thích..." nó xảy ra thường nhật.

Con cám ơn chú góp ý ạ. Con cũng cố gắng nói thế nào để người nghe có thể hiểu được ngay. Nhưng đang trong quá trình hoàn thiện bản thân.
Cảm ơn Thầy @Ba Tê nhiều ạ

 

[HieuCD]

Gửi các anh chị. Em có file đính kèm. Muốn nhờ anh chị thầy cô chỉ giúp.
Em có nghĩ đến việc sử dụng Dic. Nhưng nó vẫn không ra kết quả theo ý em muốn
Kết quả mong muốn em cũng đã để trong file.
Không giám diễn giải nhiều sợ lại lệch ý,
Mong mọi người giúp đỡ ạ

Thử code

Sub ABC()
  Dim sArr(), Res(), iKey$
  Dim eRow&, sRow&, i&, k&, ik&

  With Sheets("d")
    eRow = Sheet1.Range("H" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("H3:M" & eRow).ClearContents
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:E" & eRow).Value
    sRow = UBound(sArr, 1)
    ReDim Res(1 To sRow, 1 To 6)
  End With
  With CreateObject("Scripting.Dictionary")
    For i = 1 To sRow
      iKey = "#" & sArr(i, 4)
      If Len(iKey) Then .Item(iKey) = i
    Next i
    For i = 1 To sRow
      iKey = sArr(i, 5)
      ik = .Item("#" & iKey)
      If ik > 0 Then
        If Not .Exists(iKey) Then
          k = k + 1
          .Add iKey, k
          Res(k, 1) = sArr(ik, 1)
          Res(k, 2) = sArr(ik, 2)
          Res(k, 6) = sArr(i, 5)
        End If
        Res(k, 3) = Res(k, 3) + sArr(i, 3)
        Res(k, 4) = Res(k, 3) * 0.1
        Res(k, 5) = Res(k, 5) + 1
      End If
    Next i
  End With
  If k Then Sheets("d").Range("H3").Resize(k, 6) = Res
End Sub

 

[BuiQuangThuan]

Cám ơn Thầy @HieuCD ạ. Code Của Thầy và Thầy @Ba Tê ra đúng ý của em rồi ạ
Cảm ơn mọi người đã giúp đỡ ạ