Giúp mình giải quyết về code tính tổng và tính trung bình (2 người xem)

Elx Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
D

duongrcfee

Thành viên mới
Tham gia
6/10/10
Bài viết
13
Được thích
1
Chào các bạn!
Mình có một file excel tổng hợp các chỉ tiêu mình đang viết code thống kê các chỉ tiêu đó nhưng đến phần tính tổng và tình trung bình thì bó tay à! Mong được sự giúp đỡ của các bạn! Các file thống kê có độ dài dòng khác nhau nhé các bạn!
Mình gửi file đính kèm và đã chú giải cụ thể ở trong file!
Mong được giúp đỡ! Cám ơn nhiều!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
File ví dụ của bạn loạn lên hết, khó mà đoán được do bạn muốn vậy hay do bạn ghi lầm.
1. Dòng tiêu đề ghi lệch ký tự, cột C của bảng tính được ghi thành cột D tiêu đề. Cho đến cột N thì lặp lại 2 lần, vì vậy snag cột O thì ngay ngắn trở lại?
2. Dòng 5 thì tính tổng 2 dòng kế nó, 6 và 7. Nhưng dòng 8 thì tính tổng từ 10 đến 17, bỏ sót dòng 9.

Giải thuật như vầy. Nếu đúng thì làm tiếp. Không thì phải sửa trước khi bắt đầu.

1. Đọc dòng 4. Dùng dòng này làm tựa cột. Vì tựa cột của bạn loạn lên hết cho nên dùng tựa số, tức là số 1 đến 19
2. Đặt địa chỉ dòng tổng DongTong là 0
3. Duyệt dòng kế tiếp, nếu cột 4 dòng này không có dữ liệu thì nó là dòng chi tiết, tiếp tục vòng lại (duyệt dòng kế tiếp). Nếu cột 4 có dữ liệu thì đây là dòng tổng cho nhóm kế tiếp; trường hợp dòng trống thì đây là dòng cuối cùng; cả hai trường hợp đều phải Giải quyết dòng tổng.
4. Giải quyết dòng tổng:
4.1. Nếu DongTong là 0, đây là dòng đầu tiên, Goto 3 (duyệt dòng kế tiếp)
4.2. Ghi công thức SUM(DongTong+1:DongHienTai-1) vào cột 7, ghi AVERAGE(DongTong+1:DongHienTai-1) vào cột 8
4.4. DongTong = DongHienTai
4.3. Nếu dòng hiện tại có dữ liệu thì chưa hết dữ liệu, Goto 3 (duyệt dòng kế tiếp). Nếu không thì END
5. END (chấm dứt)
 
Upvote 0
1) Cột F (tức cột G trong bảng của bạn) toàn là chuỗi, vậy là COUNT hay SUM vậy bạn?

2) Cột H và cột R luôn luôn là màu xanh phải không bạn?

3) Toàn bộ kiểu thập phân, bạn dùng dấu phân cách là dấu phẩy (,) chẳng hạn thay vì 0.2 thì bạn lại ghi 0,2 (kiểu chuỗi) nên không tính toán được. Bạn phải chuyển những dạng số kiểu chuỗi này thành kiểu số thì các hàm mới tính toán được bạn ơi.
 
Lần chỉnh sửa cuối:
Upvote 0
OK, theo dữ liệu và cấu trúc bảng biểu của bạn tôi giúp bạn như sau:

1) Tôi chuyển tất cả dạng số kiểu chuỗi về lại kiểu số (dùng Find đổi dấu phẩy về dấu chấm)

2) Tôi cũng viết code như sau:

[GPECODE=vb]Option Explicit

Const ClrRed As Long = &HFF&
Const ClrPurple As Long = &HA03070
Const ClrYellow As Long = &HFFFF&
Const ClrGreen As Long = &H50B000


Sub NghiaDepTrai()
Dim LastRow As Long
With Sheets("Bieu 2")
.AutoFilterMode = False
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
If LastRow < 5 Then
.Range("E4:S4").AutoFilter
Exit Sub
End If
Dim ArrRows()
Dim Total As String
Dim n As Long, r As Long
Dim f As WorksheetFunction
Dim ClrRng As Range, ColorRange As Range
Set f = WorksheetFunction
Total = "C" & ChrW(7897) & "ng"
Set ColorRange = .Range("A5:A" & LastRow)
ColorRange.ClearContents
For Each ClrRng In ColorRange
If ClrRng.Interior.Color = ClrPurple Then
r = r + 1
ClrRng = f.Roman(r)
End If
Next
Set ColorRange = ColorRange.Offset(, 4)
For Each ClrRng In ColorRange
If ClrRng.Interior.Color = ClrRed Then
n = n + 1
ReDim Preserve ArrRows(1 To n)
ClrRng = Total
ArrRows(n) = ClrRng.Row
ElseIf ClrRng = "" Then
n = n + 1
ReDim Preserve ArrRows(1 To n)
ArrRows(n) = ClrRng.Row - 1
Exit For
End If
Next
If n Then
Dim c As Byte
Dim CalculatedRange As Range
Dim eSumRow As Long, fSumRow As Long, TotalRow As Long
For r = 1 To n - 1
TotalRow = ArrRows(r)
fSumRow = TotalRow + 1
eSumRow = ArrRows(r + 1)
If TotalRow = eSumRow Then
.Range("F" & TotalRow & ":S" & TotalRow).ClearContents
Exit For
Else
Set CalculatedRange = .Range("F" & fSumRow & ":F" & eSumRow)
With .Range("F" & TotalRow)
For c = 0 To 13
Select Case c
Case 2, 12
.Offset(, c) = f.Average(CalculatedRange.Offset(, c))
Case Else
.Offset(, c) = f.Sum(CalculatedRange.Offset(, c))
End Select
Next
End With
End If
Next
End If
.Range("E4:S4").AutoFilter
End With
End Sub
[/GPECODE]

3) Việc còn lại, bạn chỉ bấm nút Tính toán.

P/s: Xem file tại bài #6
 
Lần chỉnh sửa cuối:
Upvote 0
duongrcfee đã viết:
Chào các bạn!
Mình có một file excel tổng hợp các chỉ tiêu mình đang viết code thống kê các chỉ tiêu đó nhưng đến phần tính tổng và tình trung bình thì bó tay à! Mong được sự giúp đỡ của các bạn! Các file thống kê có độ dài dòng khác nhau nhé các bạn!
Mình gửi file đính kèm và đã chú giải cụ thể ở trong file!
Mong được giúp đỡ! Cám ơn nhiều!
Nhấp chuột vào đây để mở rộng...

ok, tôi chỉ làm được vậy thui.......hihihi.........mệt thật.......
mấy cột dạn tẽxt đổi qua số nha, nếu ko thìkết quả ko đúng
Mã: 
Sub tinhtumlum()

Dim bieu As Variant, tam(), n, i, j, k As Long
bieu = [a5:s113].Value
ReDim tam(1 To UBound(bieu), 1 To 19)
For i = UBound(bieu) To 1 Step -1
If Not IsEmpty(bieu(i, 5)) Then
k = k + 1
    For j = 7 To 19
        tam(k, j) = bieu(i, j)
    Next j
Else
    For j = 7 To 19
        For l = 1 To k
            bieu(i, j) = bieu(i, j) + tam(l, j)
        Next l
        If j = 8 Or j = 18 Then bieu(i, j) = bieu(i, j) / k
    Next j
    
    k = 0
End If
Next i

Sheet4.[a5].Resize(UBound(bieu), 19).Value = bieu
End Sub

Mã:
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
OK, theo dữ liệu và cấu trúc bảng biểu của bạn tôi giúp bạn như sau:

1) Tôi chuyển tất cả dạng số kiểu chuỗi về lại kiểu số (dùng Find đổi dấu phẩy về dấu chấm)

2) Tôi cũng viết code như sau:

[GPECODE=vb]Option Explicit

Sub NghiaDepTrai()
''......
End Sub
[/GPECODE]

3) Việc còn lại, bạn chỉ bấm nút Tính toán.
Nhấp chuột vào đây để mở rộng...

Do code trên chỉ đúng 1 lần đầu, còn lần sau nó sum luôn hàng ở dưới, tôi sửa lại như sau:

Mã: 
Sub NghiaDepTrai()
    On Error Resume Next
    Dim LastRow As Long
    With Sheets("Bieu 2")
        .AutoFilterMode = False
        LastRow = .Range("E" & Rows.Count).End(xlUp).Row
        If LastRow < 5 Then GoTo ExitSub
        Dim ArrRows()
        Dim Total As String
        Dim n As Long, r As Long
        Dim f As WorksheetFunction
        Dim ClrRng As Range, ColorRange As Range
        Set f = WorksheetFunction
        Total = "C" & ChrW(7897) & "ng"
        Set ColorRange = .Range("A5:A" & LastRow)
        ColorRange.ClearContents
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrPurple Then
                r = r + 1
                ClrRng = f.Roman(r)
            End If
        Next
        Set ColorRange = ColorRange.Offset(, 4)
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrRed Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
            ElseIf ClrRng = "" Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
                Exit For
            End If
        Next
        If n = 0 Or ArrRows(n) - ArrRows(1) = 1 Then GoTo ExitSub
        If n Then
            Dim c As Byte
            Dim CalculatedRange As Range
            Dim eSumRow As Long, fSumRow As Long, TotalRow As Long
            For r = 1 To n - 1
                TotalRow = ArrRows(r)
                fSumRow = TotalRow + 1
                eSumRow = ArrRows(r + 1) - 1
                Set CalculatedRange = .Range("E" & fSumRow & ":E" & eSumRow)
                With .Range("E" & TotalRow)
                    .Value = Total
                    If eSumRow < fSumRow Then
                        .Resize(, 15).ClearContents
                        Exit For
                    End If
                    For c = 1 To 14
                        Select Case c
                        Case 3, 13
                            .Offset(, c) = f.Average(CalculatedRange.Offset(, c))
                        Case Else
                            .Offset(, c) = f.Sum(CalculatedRange.Offset(, c))
                        End Select
                    Next
                End With
            Next
        End If
ExitSub:
        .Range("E4:S4").AutoFilter
    End With
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Let'GâuGâu đã viết:
ok, tôi chỉ làm được vậy thui.......hihihi.........mệt thật.......
mấy cột dạn tẽxt đổi qua số nha, nếu ko thìkết quả ko đúng
Mã: 
Sub tinhtumlum()

Dim bieu As Variant, tam(), n, i, j, k As Long
bieu = [a5:s113].Value
ReDim tam(1 To UBound(bieu), 1 To 19)
For i = UBound(bieu) To 1 Step -1
If Not IsEmpty(bieu(i, 5)) Then
k = k + 1
    For j = 7 To 19
        tam(k, j) = bieu(i, j)
    Next j
Else
    For j = 7 To 19
        For l = 1 To k
            bieu(i, j) = bieu(i, j) + tam(l, j)
        Next l
        If j = 8 Or j = 18 Then bieu(i, j) = bieu(i, j) / k
    Next j
    
    k = 0
End If
Next i

Sheet4.[a5].Resize(UBound(bieu), 19).Value = bieu
End Sub

Mã: 
[/QUOTE]
Coi lại điều kiện thử xem, hình như nó cũng bị lỗi "cộng đúp" nếu nó được gọi nhiều lần (giống mình lúc đầu đó). Với lại còn thiếu dữ kiện là nếu màu đỏ thì thêm chữ Cộng.

''=====================================================

Nếu các ô màu vàng, xanh cũng trên 1 hàng mà không theo trật tự thì chạy code này:

[GPECODE=vb]
Option Explicit
Const ClrRed As Long = &HFF&
Const ClrPurple As Long = &HA03070
Const ClrYellow As Long = &HFFFF&
Const ClrGreen As Long = &H50B000


Sub NghiaDepTrai()
    On Error Resume Next
    Dim LastRow As Long
    With Sheets("Bieu 2")
        .AutoFilterMode = False
        LastRow = .Range("E" & Rows.Count).End(xlUp).Row
        If LastRow < 5 Then GoTo ExitSub
        Dim ArrRows()
        Dim Total As String
        Dim n As Long, r As Long
        Dim f As WorksheetFunction
        Dim ClrRng As Range, ColorRange As Range
        Set f = WorksheetFunction
        Total = "C" & ChrW(7897) & "ng"
        Set ColorRange = .Range("A5:A" & LastRow)
        ColorRange.ClearContents
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrPurple Then
                r = r + 1
                ClrRng = f.Roman(r)
            End If
        Next
        Set ColorRange = ColorRange.Offset(, 4)
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrRed Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
            ElseIf ClrRng = "" Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
                Exit For
            End If
        Next
        If n = 0 Or ArrRows(n) - ArrRows(1) = 1 Then GoTo ExitSub
        If n Then
            Dim c As Byte
            Dim CalculatedRange As Range
            Dim eSumRow As Long, fSumRow As Long, TotalRow As Long
            For r = 1 To n - 1
                TotalRow = ArrRows(r)
                fSumRow = TotalRow + 1
                eSumRow = ArrRows(r + 1) - 1
                Set CalculatedRange = .Range("E" & fSumRow & ":E" & eSumRow)
                With .Range("E" & TotalRow)
                    .Value = Total
                    If eSumRow < fSumRow Then
                        .Resize(, 15).ClearContents
                        Exit For
                    End If
                    For c = 1 To 14
                        If .Offset(, c).Interior.Color = ClrGreen Then
                            .Offset(, c) = f.Average(CalculatedRange.Offset(, c))
                        ElseIf .Offset(, c).Interior.Color = ClrYellow Then
                            .Offset(, c) = f.Sum(CalculatedRange.Offset(, c))
                        End If
                    Next
                End With
            Next
        End If
ExitSub:
        .Range("E4:S4").AutoFilter
    End With
End Sub
[/GPECODE]
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Coi lại điều kiện thử xem, hình như nó cũng bị lỗi "cộng đúp" nếu nó được gọi nhiều lần (giống mình lúc đầu đó). Với lại còn thiếu dữ kiện là nếu màu đỏ thì thiêm chữ Cộng.

''=====================================================
Nhấp chuột vào đây để mở rộng...

đúng là nó bị dúp khi gọi lần thứ 2.......heheheh
chỉnh lại một chút (nhưng vẫn chưa đánh số thứ tự ở cột A)..........hihihih
Mã: 
Sub tinhtumlum()

Dim bieu As Variant, tam(), n, i, j, k As Long
bieu = [a5:s113].Value
ReDim tam(1 To UBound(bieu), 1 To 19)
For i = UBound(bieu) To 1 Step -1
'If Not IsEmpty(bieu(i, 2)) Then n = n + 1: bieu(i, 1) = n + 1
If Not IsEmpty(bieu(i, 5)) Then
k = k + 1
    For j = 7 To 19
        tam(k, j) = bieu(i, j)
    Next j
Else
bieu(i, 5) = "C" & ChrW(7897) & "ng"
    For j = 7 To 19
        For l = 1 To k
            bieu(i, j) = bieu(i, j) + tam(l, j)
        Next l
        If j = 8 Or j = 18 Then bieu(i, j) = bieu(i, j) / k
    Next j
    
    k = 0
End If
Next i

Sheet4.[a5].Resize(UBound(bieu), 19).Value = bieu
End Sub
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Do code trên chỉ đúng 1 lần đầu, còn lần sau nó sum luôn hàng ở dưới, tôi sửa lại như sau:

Mã: 
Sub NghiaDepTrai()
    On Error Resume Next
    Dim LastRow As Long
    With Sheets("Bieu 2")
        .AutoFilterMode = False
        LastRow = .Range("E" & Rows.Count).End(xlUp).Row
        If LastRow < 5 Then GoTo ExitSub
        Dim ArrRows()
        Dim Total As String
        Dim n As Long, r As Long
        Dim f As WorksheetFunction
        Dim ClrRng As Range, ColorRange As Range
        Set f = WorksheetFunction
        Total = "C" & ChrW(7897) & "ng"
        Set ColorRange = .Range("A5:A" & LastRow)
        ColorRange.ClearContents
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrPurple Then
                r = r + 1
                ClrRng = f.Roman(r)
            End If
        Next
        Set ColorRange = ColorRange.Offset(, 4)
        For Each ClrRng In ColorRange
            If ClrRng.Interior.Color = ClrRed Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
            ElseIf ClrRng = "" Then
                n = n + 1
                ReDim Preserve ArrRows(1 To n)
                ArrRows(n) = ClrRng.Row
                Exit For
            End If
        Next
        If n = 0 Or ArrRows(n) - ArrRows(1) = 1 Then GoTo ExitSub
        If n Then
            Dim c As Byte
            Dim CalculatedRange As Range
            Dim eSumRow As Long, fSumRow As Long, TotalRow As Long
            For r = 1 To n - 1
                TotalRow = ArrRows(r)
                fSumRow = TotalRow + 1
                eSumRow = ArrRows(r + 1) - 1
                Set CalculatedRange = .Range("E" & fSumRow & ":E" & eSumRow)
                With .Range("E" & TotalRow)
                    .Value = Total
                    [COLOR=#ff0000]If eSumRow < fSumRow Then
                        .Resize(, 15).ClearContents
                        Exit For
                    End If[/COLOR]
                    For c = 1 To 14
                        Select Case c
                        Case 3, 13
                            .Offset(, c) = f.Average(CalculatedRange.Offset(, c))
                        Case Else
                            .Offset(, c) = f.Sum(CalculatedRange.Offset(, c))
                        End Select
                    Next
                End With
            Next
        End If
ExitSub:
        .Range("E4:S4").AutoFilter
    End With
End Sub
Nhấp chuột vào đây để mở rộng...

Chào bạn Nghĩa,

Bạn có thể giải thích giúp mình tác dụng của đoạn code này không:

Mã: 
If eSumRow < fSumRow Then
   .Resize(, 15).ClearContents
    Exit For
End If

Mình không hình dung ra trường hợp eSumRow < fSumRow xảy ra khi nào. Hay là bạn có ý nào khác mà mình không biết ?

Cảm ơn bạn.
 
Upvote 0
mhung12005 đã viết:
Chào bạn Nghĩa,

Bạn có thể giải thích giúp mình tác dụng của đoạn code này không:

Mã: 
If eSumRow < fSumRow Then
   .Resize(, 15).ClearContents
    Exit For
End If

Mình không hình dung ra trường hợp eSumRow < fSumRow xảy ra khi nào. Hay là bạn có ý nào khác mà mình không biết ?

Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...

Bạn thêm cái này vào câu đó:

Mã: 
                    If eSumRow < fSumRow Then
[COLOR=#ff0000][B]                        MsgBox eSumRow & "/" & fSumRow[/B][/COLOR]
                        .Resize(, 15).ClearContents
                        Exit For
                    End If

Với dữ liệu có sẳn, bạn chỉ việc xóa dòng cuối cùng, tức xóa dữ liệu ở hàng 113, nếu nó có thông báo thì bạn sẽ hiểu tại sao.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Bạn thêm cái này vào câu đó:

Mã: 
                    If eSumRow < fSumRow Then
[COLOR=#ff0000][B]                        MsgBox eSumRow & "/" & fSumRow[/B][/COLOR]
                        .Resize(, 15).ClearContents
                        Exit For
                    End If

Với dữ liệu có sẳn, bạn chỉ việc xóa dòng cuối cùng, tức xóa dữ liệu ở hàng 113, nếu nó có thông báo thì bạn sẽ hiểu tại sao.
Nhấp chuột vào đây để mở rộng...

OK mình hiểu rồi, cảm ơn bạn !
 
Upvote 0
Cũng bon chen vô cái coi. Bài này chơi Do Loop mới sốc hàng chứ
Khuyến mãi thêm cái đánh số thứ tự la mã, và xử luôn cái dấu phẩy
PHP: 
Sub LoanCaoCao()
Dim Data(), i&, n As Byte, ii&, j As Byte
ActiveSheet.UsedRange.Replace ",", "."
Data = Range("a5", [S65536].End(3)(2)).Value
i = 1
Do While i < UBound(Data) - 1
   If Data(i, 2) <> "" Then
      n = n + 1
      Data(i, 1) = Application.Roman(n)
   End If
   If Data(i, 4) <> "" Then
      Data(i, 5) = "C" & ChrW(7897) & "ng"
      For j = 7 To 19
         Data(i, j) = Empty
      Next
      Do
         ii = ii + 1
         For j = 7 To 19
            Data(i, j) = Data(i, j) + Data(i + ii - 1, j)
         Next
      Loop Until Data(i + ii, 6) = Empty
      Data(i, 8) = Data(i, 8) / (ii - 1)
      Data(i, 18) = Data(i, 18) / (ii - 1)
   End If
   i = i + ii
   ii = 0
Loop
[A5].Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub
Đọc code của HTN mình đang suy nghĩ nếu chủ thớt không tô màu cho đúng mỗi khi thay đổi dữ liệu thì ... than ôi, hỡi ôi... và trời đất quỷ thần thiên địa ơi.
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn các bạn nhiều à!
Mính đã xem bài của cac bạn rồi nhưng không được đúng ý mình lắm à!
Ý mình muốn làm là những dòng trống (với điều kiện cells trên và cells dưới <>"") trong vùng bảng dữ liệu khi chạy code sẽ tự tìm đến vị trí trống với điều kiện đó để tính tổng (phần bôi màu vàng), và tính trung bình (phần bôi màu xanh) và dòng bôi màu không phải là cố định mà tuy thuộc vào độ dài của cột dữ liệu cần tính. (Bôi màu chỉ để các bạn biết cột nào tính tổng, cột nào tính Trung bình và cột nào ghi "Cộng") chứ trong bảng dữ liệu không có màu đâu à! Tại mình dùng code chạy ra nhiều bảng dữ liệu cùng form này nhưng số lượng các dòng là khác nhau nên vị trí tính là khác nhau!
Mong các bạn giúp!
Cám ơn nhiều!
 
Upvote 0
duongrcfee đã viết:
Cám ơn các bạn nhiều à!
Mính đã xem bài của cac bạn rồi nhưng không được đúng ý mình lắm à!
Ý mình muốn làm là những dòng trống (với điều kiện cells trên và cells dưới <>"") trong vùng bảng dữ liệu khi chạy code sẽ tự tìm đến vị trí trống với điều kiện đó để tính tổng (phần bôi màu vàng), và tính trung bình (phần bôi màu xanh) và dòng bôi màu không phải là cố định mà tuy thuộc vào độ dài của cột dữ liệu cần tính. (Bôi màu chỉ để các bạn biết cột nào tính tổng, cột nào tính Trung bình và cột nào ghi "Cộng") chứ trong bảng dữ liệu không có màu đâu à! Tại mình dùng code chạy ra nhiều bảng dữ liệu cùng form này nhưng số lượng các dòng là khác nhau nên vị trí tính là khác nhau!
Mong các bạn giúp!
Cám ơn nhiều!
Nhấp chuột vào đây để mở rộng...
Bạn quăng lên cái file không đúng thực tế, yêu cầu cũng không thực tế, người ta thắc mắc bạn cũng không quan tâm, rồi người ta bỏ công để làm vì đoán non đoán già, rồi giờ thì không đúng ý bạn. Thôi ai giúp thì giúp bạn tiếp đi, tôi thì chào thua. Ít ra cũng phải theo dõi bài của mình để kịp thời giải đáp thắc mắc khi người ta hỏi chứ ném bài lên như thế mặc người ta làm gì làm thì tôi chịu chết thôi.
 
Upvote 0
Mình cũng xin dừng lại tại đây. Ai hứng thú thì mời nghiên cứu tiếp nhé. Khó khó quá xá.
 
Upvote 0
/(hó không fải ở giải thuật; Khó ở chổ không thể hiểu người hỏi muốn đạt điều gì trong file;

Nhưng trước khi chủ topic xem file, mình thấy cần fải mắng cho chàng/nàng này 1 cái:

Theo như số liệu trong file, mình mường tượng đây là dân kỹ thuật;
Nếu đúng vậy, bạn cần bớt ẩu tả đi cái; Kỹ thuật không dung hòa được với sự cẩu thả hay vô chính fủ như vậy được;

Trong 1 trang số liệu, lúc thì nhập 2.8 (ô [G6]), nhưng lúc dưới lại nhập 2,6 (ô [G19])

Còn về file, mình chưa thêm từ 'Cộng' để bạn còn kiểm tra số liệu sau vài lần chạy macro; nếu thay thì lúc đó không thể chạy lại macro.
 

File đính kèm

Upvote 0
duongrcfee đã viết:
Cám ơn các bạn nhiều à!
Mính đã xem bài của cac bạn rồi nhưng không được đúng ý mình lắm à!
Ý mình muốn làm là những dòng trống (với điều kiện cells trên và cells dưới <>"") trong vùng bảng dữ liệu khi chạy code sẽ tự tìm đến vị trí trống với điều kiện đó để tính tổng (phần bôi màu vàng), và tính trung bình (phần bôi màu xanh) và dòng bôi màu không phải là cố định mà tuy thuộc vào độ dài của cột dữ liệu cần tính. (Bôi màu chỉ để các bạn biết cột nào tính tổng, cột nào tính Trung bình và cột nào ghi "Cộng") chứ trong bảng dữ liệu không có màu đâu à! Tại mình dùng code chạy ra nhiều bảng dữ liệu cùng form này nhưng số lượng các dòng là khác nhau nên vị trí tính là khác nhau!
Mong các bạn giúp!
Cám ơn nhiều!
Nhấp chuột vào đây để mở rộng...

Tôi bị bệnh mù màu cho nên không hề quan tâm gì đến các màu trong bảng tính của bạn.
Trong câu hỏi trước đây tôi có hỏi đại khái cách nhận mặt dòng tổng là xét cột mang số 4, nhưng không thấy bạn đá động gì tới.
 
Upvote 0
Theo như mình hiểu, cột chuẩn fải là cột [E], trong cột này, ta fải điền thêm cái gì đó vô những ô đang trống, cũng như các ô trống cùng hàng của nó fía fải nó cho thích hợp với iêu cầu của chủ topic;

Với dữ liệu như trong file, mình dùng macro rùa này

PHP: 
Option Explicit
Sub GhiSoLieu()
 Dim Rng As Range, WF As Object, Cls As Range, Rg0 As Range
 Dim J As Long, Rws As Long, Dg As Integer
 Dim C_ng As String
 On Error Resume Next
  
 C_ng = "C" & ChrW(7897) & "ng"
 C_ng = Range("Cong").Value
 Range([E4], [E9999].End(xlUp)).Select
 Selection.Replace What:=C_ng, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
 Set Rng = Selection.SpecialCells(xlCellTypeBlanks)
 Set WF = Application.WorksheetFunction
 For Each Cls In Rng
    If Cells(Cls.Row, "B").Value <> "" Then
        Dg = 1 + Dg
        Cells(Cls.Row, "A").Value = Choose(Dg, "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X")
    End If
    Cls.Value = C_ng
    Set Rg0 = Range(Cls.Offset(1), Cls.Offset(1).End(xlDown))
    For J = 2 To 14
        If J <> 3 And J <> 13 Then
            Rg0(1).Offset(-1, J).Value = WF.Sum(Rg0.Offset(, J))
        Else
            Rg0(1).Offset(-1, J).Value = WF.Average(Rg0.Offset(, J))
        End If
    Next J
    Set Rg0 = Nothing
 Next Cls
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.

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

L
Tính thời gian làm việc thực tế
Trả lời
66
Đọc
14K
YenTon
Y
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
630
Phuong7686
P
GPE-Trợ Lý
  • Dán lên cao
[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
91
Đọc
14K
SA_DQ
SA_DQ
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
6
Đọc
409
SA_DQ
SA_DQ
92nguyenthanh
  • Question Question
Vba cho file nhập xuất kho
Trả lời
4
Đọc
110
HUONGHCKT
H
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
25
Đọc
618
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] TALK SHOW 08: GIẢI QUYẾT VẤN ĐỀ TỐI ƯU HÓA TRONG EXCEL VỚI CÔNG CỤ SOLVER (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
4
Đọc
3K
DuongLeHung
D
Gà Công Nghệ
Chế độ chính sách cho giáo viên mầm non giữ trẻ khuyết tật
Trả lời
1
Đọc
58
vanle33
vanle33
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
22K
dunghtgiga
dunghtgiga
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
40
Đọc
12K
lan nguyen0987
L
P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
5
Đọc
109
phongvanvu
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
218
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code (1 người xem)
Trả lời
6
Đọc
160
ptm0412
ptm0412
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
315
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc.
Trả lời
8
Đọc
287
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 người xem)
    • Thích
Trả lời
0
Đọc
3K
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
135
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
371
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
702
nghiabros
N
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom