Check dữ liệu tất cả các Sheet và lấy ra top 5

hadoan-pap · 6/6/19

Em chào mọi người!
Hi @snow25

Em có bài toán rất mong mọi người giúp đỡ ạ.

Em có rất nhiều Sheet , các Sheet đều có các thông tin như nhau.

E muốn chạy toàn bộ các sheet để tìm ra dữ lieu tại ô C1 của 5 Sheet trong top 5 và điền vào cột A,B của Sheet " Sum ".

Và nó sẽ tính tổng tất cả C1 của các Sheet, điền vào ô B7 của Sheet Sum.

E xin cảm ơn!

Hai Lúa Miền Tây · 6/6/19

hadoan-pap đã viết:
Em chào mọi người!
Hi @snow25

Em có bài toán rất mong mọi người giúp đỡ ạ.

Em có rất nhiều Sheet , các Sheet đều có các thông tin như nhau.

E muốn chạy toàn bộ các sheet để tìm ra dữ lieu tại ô C1 của 5 Sheet trong top 5 và điền vào cột A,B của Sheet " Sum ".

Và nó sẽ tính tổng tất cả C1 của các Sheet, điền vào ô B7 của Sheet Sum.

E xin cảm ơn!

Sao không cộng tổng cột B mà phải lấy ở Cell C1 vậy bạn?

hadoan-pap · 6/6/19

Hai Lúa Miền Tây đã viết:
Sao không cộng tổng cột B mà phải lấy ở Cell C1 vậy bạn?

Vâng, Tại vì số hang ở cột A và B của các Sheet nó linh động thay đổi rất nhiều dựa vào item... em chỉ đưa vào 4 item để làm ví dụ thôi còn thực tế nó thay đổi liên tục. Do đó em chọn ô C1 của các Sheet để fix ạ.

CHAOQUAY · 6/6/19

@hadoan-pap
Chạy thử code này

Mã:

Sub Top5_Sum()
Dim Ws As Worksheet
Dim Sort
Dim Kq
Dim i, j, k
ReDim Sort(1)
For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If UBound(Sort) < k Then ReDim Preserve Sort(k)
        Sort(k) = Sort(k) & " " & Ws.Name
        Sort(0) = Sort(0) + k
    End If
Next Ws
ReDim Kq(1 To 2, 1 To Worksheets.Count)
Kq(1, 1) = "City"
Kq(2, 1) = "Total"
k = 1
For i = UBound(Sort) To 0 Step -1
    If Sort(i) <> "" Then
        For Each j In Split(Trim(Sort(i)))
            k = k + 1
            Kq(1, k) = j
            Kq(2, k) = i
        Next j
        If k >= 6 Then
            Kq(1, k + 1) = "All City"
            Kq(2, k + 1) = Sort(0)
            Exit For
        End If
    End If
Next i
With Sheets("Sum")
    .Range("A9").Resize(k + 1, 2) = WorksheetFunction.Transpose(Kq)
End With
End Sub

hadoan-pap · 6/6/19

CHAOQUAY đã viết:

@hadoan-pap
Chạy thử code này

Mã:

Sub Top5_Sum()
Dim Ws As Worksheet
Dim Sort
Dim Kq
Dim i, j, k
ReDim Sort(1)
For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If UBound(Sort) < k Then ReDim Preserve Sort(k)
        Sort(k) = Sort(k) & " " & Ws.Name
        Sort(0) = Sort(0) + k
    End If
Next Ws
ReDim Kq(1 To 2, 1 To Worksheets.Count)
Kq(1, 1) = "City"
Kq(2, 1) = "Total"
k = 1
For i = UBound(Sort) To 0 Step -1
    If Sort(i) <> "" Then
        For Each j In Split(Trim(Sort(i)))
            k = k + 1
            Kq(1, k) = j
            Kq(2, k) = i
        Next j
        If k >= 6 Then
            Kq(1, k + 1) = "All City"
            Kq(2, k + 1) = Sort(0)
            Exit For
        End If
    End If
Next i
With Sheets("Sum")
    .Range("A9").Resize(k + 1, 2) = WorksheetFunction.Transpose(Kq)
End With
End Sub

Code đúng rồi anh ạ.

E xin cảm ơn nhiều nhé!

hadoan-pap · 6/6/19

CHAOQUAY đã viết:

@hadoan-pap
Chạy thử code này

Mã:

Sub Top5_Sum()
Dim Ws As Worksheet
Dim Sort
Dim Kq
Dim i, j, k
ReDim Sort(1)
For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If UBound(Sort) < k Then ReDim Preserve Sort(k)
        Sort(k) = Sort(k) & " " & Ws.Name
        Sort(0) = Sort(0) + k
    End If
Next Ws
ReDim Kq(1 To 2, 1 To Worksheets.Count)
Kq(1, 1) = "City"
Kq(2, 1) = "Total"
k = 1
For i = UBound(Sort) To 0 Step -1
    If Sort(i) <> "" Then
        For Each j In Split(Trim(Sort(i)))
            k = k + 1
            Kq(1, k) = j
            Kq(2, k) = i
        Next j
        If k >= 6 Then
            Kq(1, k + 1) = "All City"
            Kq(2, k + 1) = Sort(0)
            Exit For
        End If
    End If
Next i
With Sheets("Sum")
    .Range("A9").Resize(k + 1, 2) = WorksheetFunction.Transpose(Kq)
End With
End Sub

Em xin lỗi em có 1 chút lỗi nhỏ trong đoạn code ạ.

E copy đoạn code này sang file khác của em để chạy thì bị lỗi với 2 dòng code e có khoanh đỏ, nếu bỏ 2 dòng code này thì nó chạy OK.

2 dòng code này liên quan đến hang "All City" anh ạ.

Nó báo lỗi "Type mismatch" trong khi e chạy, bỏ 2 dòng code này thì chạy xong nhưng k có kết quả All City.

Anh check giúp em nhé.

E cảm ơn!

Ba Tê · 6/6/19

hadoan-pap đã viết:
Em xin lỗi em có 1 chút lỗi nhỏ trong đoạn code ạ.

E copy đoạn code này sang file khác của em để chạy thì bị lỗi với 2 dòng code e có khoanh đỏ, nếu bỏ 2 dòng code này thì nó chạy OK.

2 dòng code này liên quan đến hang "All City" anh ạ.

Nó báo lỗi "Type mismatch" trong khi e chạy, bỏ 2 dòng code này thì chạy xong nhưng k có kết quả All City.

Anh check giúp em nhé.

E cảm ơn!

Anh Bill đã làm sẵn công cụ Sort dữ liệu, cứ lấy mà xài.
Ô C1 sheet "Sum" bạn luôn lấy top 5 nên tự nhập công thức =SUM(B2:B6)
Có nhiều hơn 1 dòng cùng số liệu thứ 5 thì chỉ lấy 1.

PHP:

Option Explicit


Public Sub GomBi()
Dim Ws As Worksheet, Arr(1 To 100, 1 To 2), K As Long
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Sum" Then
        K = K + 1
        Arr(K, 1) = Ws.Name
        Arr(K, 2) = Ws.Range("C1").Value
    End If
Next Ws
With Sheets("Sum")
    .Range("A2:B6").ClearContents
    If K Then
        .Range("A2:B2").Resize(K) = Arr
        .Range("A2:B2").Resize(K).Sort Key1:=.Range("B2"), Order1:=xlDescending
        .Range("A7:B7").Resize(100).ClearContents
    End If
End With
End Sub

Hai Lúa Miền Tây · 6/6/19

hadoan-pap đã viết:
Vâng, Tại vì số hang ở cột A và B của các Sheet nó linh động thay đổi rất nhiều dựa vào item... em chỉ đưa vào 4 item để làm ví dụ thôi còn thực tế nó thay đổi liên tục. Do đó em chọn ô C1 của các Sheet để fix ạ.

Không cần thiết phải thế bạn. Ta có thể không dựa vào cell trung gian là C1 để tổng hơp mà dựa vào số thực tế phát sinh ở cột B.

CHAOQUAY · 6/6/19

hadoan-pap đã viết:
Em xin lỗi em có 1 chút lỗi nhỏ trong đoạn code ạ.

E copy đoạn code này sang file khác của em để chạy thì bị lỗi với 2 dòng code e có khoanh đỏ, nếu bỏ 2 dòng code này thì nó chạy OK.

2 dòng code này liên quan đến hang "All City" anh ạ.

Nó báo lỗi "Type mismatch" trong khi e chạy, bỏ 2 dòng code này thì chạy xong nhưng k có kết quả All City.

Anh check giúp em nhé.

E cảm ơn!

Bạn thay đoạn tren bang đoạn duới

Mã:

For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If UBound(Sort) < k Then ReDim Preserve Sort(k)
        Sort(k) = Sort(k) & " " & Ws.Name
        Sort(0) = Sort(0) + k
    End If
Next Ws

Mã:

For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If k Then
            If UBound(Sort) < k Then ReDim Preserve Sort(k)
            Sort(k) = Sort(k) & " " & Ws.Name
            Sort(0) = Sort(0) + k
        End If
    End If
Next Ws

hadoan-pap · 6/6/19

CHAOQUAY đã viết:

Bạn thay đoạn tren bang đoạn duới

Mã:

For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If UBound(Sort) < k Then ReDim Preserve Sort(k)
        Sort(k) = Sort(k) & " " & Ws.Name
        Sort(0) = Sort(0) + k
    End If
Next Ws

Mã:

For Each Ws In Worksheets
    If Ws.Name <> "Sum" Then
        k = Ws.Range("C1")
        If k Then
            If UBound(Sort) < k Then ReDim Preserve Sort(k)
            Sort(k) = Sort(k) & " " & Ws.Name
            Sort(0) = Sort(0) + k
        End If
    End If
Next Ws

^^... E cảm ơn ạ!

Check dữ liệu tất cả các Sheet và lấy ra top 5

hadoan-pap

Thành viên tiêu biểu

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

hadoan-pap

Thành viên tiêu biểu

CHAOQUAY

Thành viên gắn bó

hadoan-pap

Thành viên tiêu biểu

hadoan-pap

Thành viên tiêu biểu

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

CHAOQUAY

Thành viên gắn bó

hadoan-pap

Thành viên tiêu biểu

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

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

Đếm ngược thời gian