Dùng VBA tính trung bình (cứ cách 4 giá trị lại lấy 1 giá trị để tính trung bình) (2 người xem)

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

myguitar

Thành viên mới
Tham gia
23/10/14
Bài viết
29
Được thích
1
Các cao thủ giúp em bài này với ạ.

Em có 1 chuỗi số liệu ví dụ từ ô A1 đến A10000. Em cần tính trung bình và tính độ lệch chuẩn của (A1, A5, A10, A15,....,A1990,A1995,A10000) thì lệnh trong VBA thế nào ạ?

Em có gửi ví dụ kiểu tính trung bình và độ lệch chuẩn này trong tệp excel đính kèm mà em tính thủ công để các bác hình dung.
Em cảm ơn các bác nhiều nhiều!
 

File đính kèm

PHP:
Option Explicit
Sub TinhTrungBinh_DoLechChuan()
 Dim Rng As Range, WF As Object
 Dim J As Long, Rws As Long, W As Byte
 
 Rws = [b2].CurrentRegion.Rows.Count
 Set WF = Application.WorksheetFunction
 For W = 0 To 3
    For J = 1 To Rws Step 4
        If Rng Is Nothing Then
            Set Rng = Cells(J + W, "B")
        Else
            Set Rng = Union(Rng, Cells(J + W, "B"))
        End If
    Next J
    Cells(2 + W, "C").Value = WF.Average(Rng)
    Cells(W + 2, "D").Value = WF.StDev(Rng)
    Set Rng = Nothing
 Next W
End Sub
 
Upvote 0
Các cao thủ giúp em bài này với ạ.

Em có 1 chuỗi số liệu ví dụ từ ô A1 đến A10000. Em cần tính trung bình và tính độ lệch chuẩn của (A1, A5, A10, A15,....,A1990,A1995,A10000) thì lệnh trong VBA thế nào ạ?

1 rồi 5 rồi 10 rồi 15.. là "nhảy" theo kiểu gì vậy ta? Ý tôi là cái QUY LUẬT ấy
 
Upvote 0
1 rồi 5 rồi 10 rồi 15.. là "nhảy" theo kiểu gì vậy ta? Ý tôi là cái QUY LUẬT ấy

Ui, bác hỏi e mới nhận ra là viết nhầm **~**

Dữ liệu của em để theo dòng, từ dòng 1 đến dòng 10.000. Em cần tính trung bình và độ lệch chuẩn của các giá trị theo quy tắc nhảy là 1 rồi 6 rồi 11 rồi 16....Nghĩa là cứ cách 5 giá trị thì lại lấy 1 giá trị để tính. Rồi sau đó lại tính đến trung bình của 2 rồi 7 rồi 12, rồi 17,....
Nhờ bác chỉ giáo giúp em lệnh VBA để tính bài này với ạ.

Em cảm ơn bác nhiều!
 
Upvote 0
Ui, bác hỏi e mới nhận ra là viết nhầm **~**

Dữ liệu của em để theo dòng, từ dòng 1 đến dòng 10.000. Em cần tính trung bình và độ lệch chuẩn của các giá trị theo quy tắc nhảy là 1 rồi 6 rồi 11 rồi 16....Nghĩa là cứ cách 5 giá trị thì lại lấy 1 giá trị để tính. Rồi sau đó lại tính đến trung bình của 2 rồi 7 rồi 12, rồi 17,....
Nhờ bác chỉ giáo giúp em lệnh VBA để tính bài này với ạ.

Em cảm ơn bác nhiều!

Thử code này coi thế nào. Bói làm cho vui chứ khó mà trúng ý
PHP:
Sub Tinh()
Dim data(), Res(), i, j, k, Res2(), temp()
data = Range([B1], [B65536].End(3)).Value
ReDim Res(1 To UBound(data), 1 To 1)
ReDim Res2(1 To UBound(data), 1 To 1)
For i = 1 To UBound(data)
   For j = i To UBound(data) Step 5
      k = k + 1
      ReDim Preserve temp(1 To k)
      Res(i, 1) = Res(i, 1) + data(j, 1)
      temp(k) = data(j, 1)
   Next
   Res(i, 1) = Res(i, 1) / k
   'Res2(i, 1) = Application.StDev(temp)
   If i + 4 < UBound(data) Then Res2(i, 1) = Application.StDev(temp)
   k = 0
Next
[E1].Resize(i - 1) = Res
[F1].Resize(i - 1) = Res2
End Sub
 
Upvote 0
Thử code này coi thế nào. Bói làm cho vui chứ khó mà trúng ý
PHP:
Sub Tinh()
Dim data(), Res(), i, j, k, Res2(), temp()
data = Range([B1], [B65536].End(3)).Value
ReDim Res(1 To UBound(data), 1 To 1)
ReDim Res2(1 To UBound(data), 1 To 1)
For i = 1 To UBound(data)
   For j = i To UBound(data) Step 5
      k = k + 1
      ReDim Preserve temp(1 To k)
      Res(i, 1) = Res(i, 1) + data(j, 1)
      temp(k) = data(j, 1)
   Next
   Res(i, 1) = Res(i, 1) / k
   'Res2(i, 1) = Application.StDev(temp)
   If i + 4 < UBound(data) Then Res2(i, 1) = Application.StDev(temp)
   k = 0
Next
[E1].Resize(i - 1) = Res
[F1].Resize(i - 1) = Res2
End Sub

Bói theo code của Quang Hải xem sao
PHP:
Public Function MyAverage(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem As Double, I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    Tem = Tem + Arr(I, 1)
Next I
MyAverage = Tem / K
End Function
PHP:
Public Function MySTDEV(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem(), I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    ReDim Preserve Tem(1 To K)
    Tem(K) = Arr(I, 1)
Next I
MySTDEV = Application.WorksheetFunction.StDev(Tem)
End Function
Dùng Function cho người dùng muốn "nhảy bi nhiêu thì nhảy" trong cột số liệu
 

File đính kèm

Upvote 0
Bói theo code của Quang Hải xem sao
PHP:
Public Function MyAverage(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem As Double, I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    Tem = Tem + Arr(I, 1)
Next I
MyAverage = Tem / K
End Function
PHP:
Public Function MySTDEV(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem(), I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    ReDim Preserve Tem(1 To K)
    Tem(K) = Arr(I, 1)
Next I
MySTDEV = Application.WorksheetFunction.StDev(Tem)
End Function
Dùng Function cho người dùng muốn "nhảy bi nhiêu thì nhảy" trong cột số liệu

Ôi, bác Ba Tê của em đây rồi -\\/. Em cảm ơn bác nhiều ạ! Ngưỡng mộ bác quá!
 
Upvote 0
Bói theo code của Quang Hải xem sao
PHP:
Public Function MyAverage(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem As Double, I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    Tem = Tem + Arr(I, 1)
Next I
MyAverage = Tem / K
End Function
PHP:
Public Function MySTDEV(Rng As Range, Optional Num As Long = 1) As Double
Dim Arr(), Tem(), I As Long, K As Long
Arr = Rng.Value
For I = 1 To UBound(Arr, 1) Step Num
    K = K + 1
    ReDim Preserve Tem(1 To K)
    Tem(K) = Arr(I, 1)
Next I
MySTDEV = Application.WorksheetFunction.StDev(Tem)
End Function
Dùng Function cho người dùng muốn "nhảy bi nhiêu thì nhảy" trong cột số liệu
Với 10 000 dòng dữ liệu mà anh dám mần bằng UDF thì kể ra anh cũng gan lắm nha.
 
Upvote 0
Theo bài thì trước sau gì cũng đọc hết mảng từ đầu dến cuối. Như vậy ta không cần phải đọc từng cụm (nhảy từng bước 5, và 5 bước trong đó). Chỉ cần dùng mảng để đẩy dữ liệu riêng vào từng nhóm.

Mã:
Public Function GroupSamples(ByVal rg As Range, ByVal numGroups As Integer) As Variant
[COLOR=#008000]' hàm gọp một khoảng range thành từng nhóm 
' hàm trả về một mmangr của mảng, mỗi mảng là một nhóm
[/COLOR]Dim outer() As Variant, inner() As Variant
Dim dat As Variant
Dim rw As Integer
Dim uLim As Integer, grpI As Integer
dat = rg.Value2
uLim = UBound(dat)
ReDim outer(1 To numGroups)
For grpI = 1 To numGroups [COLOR=#008000]' dựng trước số mảng[/COLOR]
    ReDim inner(1 To (uLim \ numGroups + IIf(uLim Mod numGroups >= grpI, 1, 0)))
    outer(grpI) = inner
Next grpI
For rw = 1 To uLim ' [COLOR=#008000]phân mảng lớn thành từng nhóm mảng con[/COLOR]
    grpI = ((rw - 1) Mod numGroups) + 1
    outer(grpI)((rw - 1) \ numGroups + 1) = dat(rw, 1)
Next rw
GroupSamples = outer
End Function

Public Function GroupMeans(ByVal rg As Range, ByVal numGroups As Integer) As Variant
[COLOR=#008000]' hàm tính trung bình theo từng nhóm
' chọn n ô theo hàng ngang và gõ công thức =GroupMeans(range, số nhóm), kết thúc bằng ctrl+shift+ennter (công thức mảng)
' nếu muốn hàng dọc thì thêm transpose; =transpose(GroupMeans(...[/COLOR]
Dim dat As Variant
Dim res() As Double
dat = GroupSamples(rg, numGroups)
ReDim res(1 To UBound(dat))
Dim i As Integer
For i = 1 To UBound(dat)
res(i) = Application.Average(dat(i))
Next i
GroupMeans = res
End Function

Public Function GroupStDevs(ByVal rg As Range, ByVal numGroups As Integer) As Variant
[COLOR=#008000]' hàm tính độ lệch chuẩn theo từng nhóm
' chọn n ô theo hàng ngang và gõ công thức =GroupStdevs(range, số nhóm), kết thúc bằng ctrl+shift+ennter (công thức mảng)
' nếu muốn hàng dọc thì thêm transpose; =transpose([COLOR=#008000]GroupStdevs[/COLOR](...[/COLOR]
Dim dat As Variant
Dim res() As Double
dat = GroupSamples(rg, numGroups)
ReDim res(1 To UBound(dat))
Dim i As Integer
For i = 1 To UBound(dat)
res(i) = Application.StDev(dat(i))
Next i
GroupStDevs = res
End Function
 
Upvote 0

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

Back
Top Bottom