Dùng VBA tính tổng các trung bình của 1 chuỗi giá trị (4 người xem)

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)
M

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ải giúp em bài này với ạ:
Em có 1 chuỗi số liệu a1 đến a26. Em cần tính chuỗi b, trong đó:
Giá trị b1= tổng của các trung bình của 20 giá trị đầu tiên từ a1 đến a20. Các trung bình tính bằng trung bình của a1; trung bình của a1,a2; trung bình của a1,a2,a3,...,trung bình của a1,a2,a3,...,a20.

Giá trị b2 = tổng các giá trị trung bình của 20 giá trị từ a2 đến a1. Các trung bình tính bằng trung bình của a2; trung bình của a2,a3; ....; trung bình của a2,a3,...,a21

Cứ như thế, b7 = tổng các giá trị trung bình của 20 giá trị từ a7 đến a26. Các trung bình tính bằng trung bình của a7, trung bình của a7,a8;...; trung bình của a7,a8,...,a26.

Bộ dữ liệu của em có khoảng 10 nghìn số, nên em xác định dùng VBA nhưng mới bập bẹ đọc được một ít phần này. Nhờ các cao thủ ra tay giúp em với !$@!!

Em xin phép gửi tệp Excel đính kèm mà em tính thủ công để các bác dễ hình dung.

Em cảm ơn cả nhà!
 

File đính kèm

vba chờ cao thủ nha, cthức thử vậy xem

Mã: 
L4=SUMPRODUCT(SUBTOTAL(9,OFFSET($B$3,COLUMN(A1)-1,,COLUMN($A$1:$T$1)))/COLUMN($A$1:$T$1))
 
myguitar đã viết:
Các cao thủ giải giúp em bài này với ạ:
Em có 1 chuỗi số liệu a1 đến a26. Em cần tính chuỗi b, trong đó:
Giá trị b1= tổng của các trung bình của 20 giá trị đầu tiên từ a1 đến a20. Các trung bình tính bằng trung bình của a1; trung bình của a1,a2; trung bình của a1,a2,a3,...,trung bình của a1,a2,a3,...,a20.

Giá trị b2 = tổng các giá trị trung bình của 20 giá trị từ a2 đến a1. Các trung bình tính bằng trung bình của a2; trung bình của a2,a3; ....; trung bình của a2,a3,...,a21

Cứ như thế, b7 = tổng các giá trị trung bình của 20 giá trị từ a7 đến a26. Các trung bình tính bằng trung bình của a7, trung bình của a7,a8;...; trung bình của a7,a8,...,a26.

Bộ dữ liệu của em có khoảng 10 nghìn số, nên em xác định dùng VBA nhưng mới bập bẹ đọc được một ít phần này. Nhờ các cao thủ ra tay giúp em với !$@!!

Em xin phép gửi tệp Excel đính kèm mà em tính thủ công để các bác dễ hình dung.

Em cảm ơn cả nhà!
Nhấp chuột vào đây để mở rộng...
Mã: 
Function AVE(r As Range, k As Integer, c As Integer)
For i = k To c + k - 1
For j = i To c + k - 1
AVE = AVE + r(i) / (j - k + 1)
Next
Next
End Function
L4=AVE($B$3:$B$28,COLUMN(A:A),20)
 
myguitar đã viết:
Các cao thủ giải giúp em bài này với ạ:
Em có 1 chuỗi số liệu a1 đến a26. Em cần tính chuỗi b, trong đó:
Giá trị b1= tổng của các trung bình của 20 giá trị đầu tiên từ a1 đến a20. Các trung bình tính bằng trung bình của a1; trung bình của a1,a2; trung bình của a1,a2,a3,...,trung bình của a1,a2,a3,...,a20.

Giá trị b2 = tổng các giá trị trung bình của 20 giá trị từ a2 đến a1. Các trung bình tính bằng trung bình của a2; trung bình của a2,a3; ....; trung bình của a2,a3,...,a21

Cứ như thế, b7 = tổng các giá trị trung bình của 20 giá trị từ a7 đến a26. Các trung bình tính bằng trung bình của a7, trung bình của a7,a8;...; trung bình của a7,a8,...,a26.

Bộ dữ liệu của em có khoảng 10 nghìn số, nên em xác định dùng VBA nhưng mới bập bẹ đọc được một ít phần này. Nhờ các cao thủ ra tay giúp em với !$@!!

Em xin phép gửi tệp Excel đính kèm mà em tính thủ công để các bác dễ hình dung.

Em cảm ơn cả nhà!
Nhấp chuột vào đây để mở rộng...

Cột 10.000 số, chia ra mỗi cột 20 số, vậy khoảng 500 cột. Excel 2003 làm sao chịu nỗi?
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, CoL As Long, Tem As Double
sArr = Range([B3], [B3].End(xlDown)).Value2
CoL = UBound(sArr, 1) - 19
ReDim dArr(1 To UBound(sArr, 1), 1 To CoL)
For I = 1 To CoL
    K = 1
    Tem = sArr(I, 1)
    dArr(I, I) = Tem
    For J = I + 1 To I + 19
        K = K + 1
        Tem = Tem + sArr(J, 1)
        dArr(J, I) = Tem / K
    Next J
Next I
[C3].Resize(UBound(sArr, 1), CoL) = dArr
End Sub
 
Ba Tê đã viết:
Cột 10.000 số, chia ra mỗi cột 20 số, vậy khoảng 500 cột. Excel 2003 làm sao chịu nỗi?
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, CoL As Long, Tem As Double
sArr = Range([B3], [B3].End(xlDown)).Value2
CoL = UBound(sArr, 1) - 19
ReDim dArr(1 To UBound(sArr, 1), 1 To CoL)
For I = 1 To CoL
    K = 1
    Tem = sArr(I, 1)
    dArr(I, I) = Tem
    For J = I + 1 To I + 19
        K = K + 1
        Tem = Tem + sArr(J, 1)
        dArr(J, I) = Tem / K
    Next J
Next I
[C3].Resize(UBound(sArr, 1), CoL) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Em cảm ơn bác nhé. Em để dữ liệu theo dòng mà Excel thì có khoảng 16.000 dòng nên vẫn ok bác ạ.

Em sẽ làm theo sự chỉ giáo của các cao thủ. Nếu được thì phiền bác gửi lại trong tệp Excel để em tham khảo ạ. Em xin cảm ơn các bác rất nhiều! -=.,,
 
Bài này là thực tế công việc hay là đề bài trong lớp học?
Trong thực tế công việc, người ta có thể tự coi như máy tính rất mạnh, chỉ cần viết code cho dễ hiểu và sát với vấn đề.
Trong bài tập, học sinh phải dựa trên giải thuyết máy tính yếu, mọi giải thuật phải đưa về độ phức tạp thấp, tức là phải mổ xẻ vấn đề sao cho giải thuật dùng càng ít con toán càng tốt, mặc dầu code có thể rất rườm rà.

Nếu là thực tế thì làm theo #3, #4 thì được rồi (tôi chưa thử nhưng cứ nhìn đại khái code thì thấy giải thuật chấp nhận được. Chuyện đúng sai thì để lúc thử rồi chỉnh code sau)

Nhưng nếu là bài tập trong lớp học thì phải giải theo kiểu toán. Tức là phải đặt giả thuyết trên môi trường máy tính rất chậm, vấn đề phải được tính lại (theo như file gởi lên thì bạn đã đi được một phần mổ xẻ rồi nhưng bạn chưa biết cách ghép lại)

Để tính được b1, bạn cần tính:
B1(1) = a1
B1(2) = a1 + a2
B1(3) = a1 + a2 + a3
…
B1(20) = a1 + a2 + … + a20
Tổng B1 = B1(1)/1 + B1(2)/2 + B1(3)/3 + … + B1(20)/20

Nếu cứ mỗi Bn bạn phải làm lại con toán cộng cho từng Bn(i) như trên thì thừa nhiều quá.
Để ý phân tích sẽ thấy

B2(1) = B1(1) – a1 + a2 = B1(2) – a1
B2(2) = B1(2) – a1 + a3 = B1(3) – a1
…
Như vậy, nếu đặt m = n-1 thì:
Bn(i) = Bm(i+1) – am

Code hơi phức tạp nhưng thật sự độ phức tạp giải thuật giảm rất nhiều.

Lưu ý: theo đúng toán học thuần túy thì phải tính
a1/1, a1/2, a1/3…; a2/1, a2/2, a2/3…;…
Rồi cộng lại để cho ra tổng trung bình.
Nhưng theo lập trình, con toán chia sẽ gây số lẻ thập phân và đưa đến mất chính xác dữ liệu. Cho nên theo thói quen lập trình người ta làm tính thế nào để chia càng trễ càng tốt – trừ phi con toán có khả năng tràn số vì lớn quá.
 
myguitar đã viết:
Em cảm ơn bác nhé. Em để dữ liệu theo dòng mà Excel thì có khoảng 16.000 dòng nên vẫn ok bác ạ.

Em sẽ làm theo sự chỉ giáo của các cao thủ. Nếu được thì phiền bác gửi lại trong tệp Excel để em tham khảo ạ. Em xin cảm ơn các bác rất nhiều! -=.,,
Nhấp chuột vào đây để mở rộng...

Sửa lại theo chiều dọc xem sao.
 

File đính kèm

Lần chỉnh sửa cuối:
myguitar đã viết:
Em cảm ơn bác nhé. Em để dữ liệu theo dòng mà Excel thì có khoảng 16.000 dòng nên vẫn ok bác ạ.

Em sẽ làm theo sự chỉ giáo của các cao thủ. Nếu được thì phiền bác gửi lại trong tệp Excel để em tham khảo ạ. Em xin cảm ơn các bác rất nhiều! -=.,,
Nhấp chuột vào đây để mở rộng...
Thêm 1 kiểu khác có khuyến mãi thêm cái dòng cộng tổng
PHP: 
Sub VongLap()
Dim Data(), Res(), I&, J&, K&, n&, Temp As Double
Data = Range([B3], [B65536].End(3)).Value
ReDim Res(1 To UBound(Data) + 1, 1 To 1)
n = 1
For I = 1 To UBound(Data)
   For J = I To UBound(Data)
      K = K + 1
      Temp = Temp + Data(J, 1)
      Res(J, n) = Temp / K
      Res(UBound(Res), n) = Res(UBound(Res), n) + Res(J, n)
      If J = UBound(Data) Then GoTo Thoat
      If K = 20 Then
         n = n + 1
         ReDim Preserve Res(1 To UBound(Res), 1 To n)
         K = 0: Temp = 0: Exit For
      End If
   Next
Next
Thoat:
[D3].Resize(UBound(Res), n) = Res
End Sub
 
VetMini đã viết:
Bài này là thực tế công việc hay là đề bài trong lớp học?
Trong thực tế công việc, người ta có thể tự coi như máy tính rất mạnh, chỉ cần viết code cho dễ hiểu và sát với vấn đề.
Trong bài tập, học sinh phải dựa trên giải thuyết máy tính yếu, mọi giải thuật phải đưa về độ phức tạp thấp, tức là phải mổ xẻ vấn đề sao cho giải thuật dùng càng ít con toán càng tốt, mặc dầu code có thể rất rườm rà.

Nếu là thực tế thì làm theo #3, #4 thì được rồi (tôi chưa thử nhưng cứ nhìn đại khái code thì thấy giải thuật chấp nhận được. Chuyện đúng sai thì để lúc thử rồi chỉnh code sau)

Nhưng nếu là bài tập trong lớp học thì phải giải theo kiểu toán. Tức là phải đặt giả thuyết trên môi trường máy tính rất chậm, vấn đề phải được tính lại (theo như file gởi lên thì bạn đã đi được một phần mổ xẻ rồi nhưng bạn chưa biết cách ghép lại)

Để tính được b1, bạn cần tính:
B1(1) = a1
B1(2) = a1 + a2
B1(3) = a1 + a2 + a3
…
B1(20) = a1 + a2 + … + a20
Tổng B1 = B1(1)/1 + B1(2)/2 + B1(3)/3 + … + B1(20)/20

Nếu cứ mỗi Bn bạn phải làm lại con toán cộng cho từng Bn(i) như trên thì thừa nhiều quá.
Để ý phân tích sẽ thấy

B2(1) = B1(1) – a1 + a2 = B1(2) – a1
B2(2) = B1(2) – a1 + a3 = B1(3) – a1
…
Như vậy, nếu đặt m = n-1 thì:
Bn(i) = Bm(i+1) – am

Code hơi phức tạp nhưng thật sự độ phức tạp giải thuật giảm rất nhiều.

Lưu ý: theo đúng toán học thuần túy thì phải tính
a1/1, a1/2, a1/3…; a2/1, a2/2, a2/3…;…
Rồi cộng lại để cho ra tổng trung bình.
Nhưng theo lập trình, con toán chia sẽ gây số lẻ thập phân và đưa đến mất chính xác dữ liệu. Cho nên theo thói quen lập trình người ta làm tính thế nào để chia càng trễ càng tốt – trừ phi con toán có khả năng tràn số vì lớn quá.
Nhấp chuột vào đây để mở rộng...

Em cảm ơn bác đã quan tâm nhé. Bài này là để xử lý dữ liệu trong công việc chứ không nhằm mục đích giảng dạy bác ạ.
 
Tôi đưa code cho bạn nào muốn nghiên cứu về giải thuật nêu ở bài #6. Như đã nói trước, giải thuật này chỉ cốt yếu tối ưu độ phức tạp thuật toán chứ không tối ưu độ phức tạp code.
Nguyên tắc của thuật toán này là tính tổng một lần đầu, sau đó chỉ trừ ra và thêm vào chứ không tổng lại.

Mã: 
Sub t()
[COLOR=#008000]' code tính tổng trung bình một dãy số
[/COLOR]Const NUMSUM = 20 [COLOR=#008000]' số hàng cần tính trung bình[/COLOR]
Const NUMROWS = 26 [COLOR=#008000]' số hàng dữ liệu[/COLOR]
Const DULIEU = "B3" [COLOR=#008000]' ô đầu tiên chứa dữ liệu[/COLOR]
Const KETQUA = "S3" ' [COLOR=#008000]ô đầu tiên ghi kết quả[/COLOR]
Dim dat As Variant
Dim ASum(1 To NUMSUM + 1) As Double[COLOR=#008000] ' sum matrix array[/COLOR]
Dim ARes(1 To NUMROWS - NUMSUM + 1, 1 To 1) As Double [COLOR=#008000]' resulting array[/COLOR]
Dim prev As Double [COLOR=#008000]' value to be taken out when moving to next data subblock[/COLOR]
Dim i As Integer, j As Integer[COLOR=#008000] ' outer and inner loop counter[/COLOR]
dat = Range(DULIEU).Resize(NUMROWS).Value2
[COLOR=#008000]' build the initial sum array[/COLOR]
ASum(1) = dat(1, 1)
For i = 2 To NUMSUM + 1
    ASum(i) = ASum(i - 1) + dat(i, 1)
Next i
[COLOR=#008000]' calculate the resulting array[/COLOR]
For i = 1 To NUMROWS - NUMSUM + 1
    prev = ASum(1) [COLOR=#008000]' amount to subtract when shifting to next block[/COLOR]
    For j = 1 To NUMSUM
        ARes(i, 1) = ARes(i, 1) + ASum(j) / j [COLOR=#008000]' resulting total[/COLOR]
        If j < NUMSUM Then
            ASum(j) = ASum(j + 1) - prev[COLOR=#008000][/COLOR]
        Else
            If i + NUMSUM <= NUMROWS Then ASum(j) = ASum(j) - prev + dat(i + NUMSUM, 1)
        End If
    Next j
Next i
Range(KETQUA).Resize(UBound(ARes), 1) = ARes
End Sub
 
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

thlpro
Cách lập Công thức tính số ngày nghỉ AL, ưu tiên tính 2024 trước rồi mới tính 2025 (1 người xem)
Trả lời
2
Đọc
47
thlpro
thlpro
G
Tách công thức ra khỏi chuỗi và tính kết quả?
2
Trả lời
22
Đọc
2K
gobi
gobi
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
5
Đọc
110
VetMini
V
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
3
Đọc
149
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
346
Đọc
31K
Vandat1607
V
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
15
Đọc
252
Hoangkhang01213
Hoangkhang01213
M
Xin giúp đỡ làm công thức điều kiện
Trả lời
2
Đọc
132
Hoangkhang01213
Hoangkhang01213
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (1 người xem)
Trả lời
4
Đọc
181
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (1 người xem)
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
303
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
171
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
580
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
149
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
811
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
249
Hoàng Tuấn 868
H
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom