Nhờ viết code cộng với số dư trung bình

vova2209 · 2/5/23

Anh chị viết giúp em code với dữ liệu như hình dưới:
Tại ô active R1 = -0.62 chia cho (Application.InputBox quét L1:L10 đếm được 10 ô có dữ liệu)
R1 = -0.62/10 = -0.062 => sau đó L1 - -0.062, L2 - -0.062.... L10 - -0.062
Kết quả như ở cột U

VetMini · 2/5/23

vova2209 đã viết:
Anh chị viết giúp em code với dữ liệu như hình dưới:
Tại ô active R1 = -0.62 chia cho (Application.InputBox quét L1:L10 đếm được 10 ô có dữ liệu)
R1 = -0.62/10 = -0.062 => sau đó L1 - -0.062, L2 - -0.062.... L10 - -0.062
Kết quả như ở cột U
...

1. Lý do tại sao không làm tay được vậy? Chỉ 1 vài thao tác copy/paste thôi chứ gì. Macro thì cũng tiết kiệm được 1-2 thao tác nhỏ là cùng.

2. Nếu cái phần tô đậm trên chọn nhầm (10 ô chọn thành 9 hay 11) thì sao? Lại phải viết thêm code tra vfee ban đầu. Thủ công thì ít ra Ctrl+z được.

vova2209 · 2/5/23

VetMini đã viết:
1. Lý do tại sao không làm tay được vậy? Chỉ 1 vài thao tác copy/paste thôi chứ gì. Macro thì cũng tiết kiệm được 1-2 thao tác nhỏ là cùng.

2. Nếu cái phần tô đậm trên chọn nhầm (10 ô chọn thành 9 hay 11) thì sao? Lại phải viết thêm code tra vfee ban đầu. Thủ công thì ít ra Ctrl+z được.

Đây là ví dụ mình cắt bớt dữ liệu đi thôi. số lượng lớn làm thủ công cũng bị lâu
Application.InputBox quét quet chọn đếm đối tượng. Dữ liệu cột L là số chết copy ra ngoài để lưu phòng trường hợp quét nhầm 9 thành 11 chắc là được

SA_DQ · 2/5/23

Bạn thử với con macro này xem sao:

PHP:

Sub TinhTrungBinhVaChep()
 Dim Rng As Range, WF As Object
 Dim Rws As Long, TB As Double, J As Long
 
 Rws = Cells(999999, "U").End(xlUp).Row
 Set WF = Application.WorksheetFunction
 For J = 1 To Rws
    With Cells(J, "R")
        If .Value <> "" Then
            Set Rng = .Offset(, 3).CurrentRegion
            TB = WF.Sum(Rng) / Rng.Cells.Count
            .Offset(, -6).Resize(Rng.Cells.Count).Value = TB
        End If
    End With
 Next J
End Sub

VetMini · 2/5/23

vova2209 đã viết:
Đây là ví dụ mình cắt bớt dữ liệu đi thôi. số lượng lớn làm thủ công cũng bị lâu

Tôi chắc chắn là do bạn hồi nào giờ ít làm thủ công. Cứ thấy công việc dài 1 chút là lên GPE xin code giải quyết.
Tôi rất ít khi dùng macro. Vì vậy tôi xử lý các thao tác file Excel nhanh như mấy bạn trẻ bấm text trên phone.

vova2209 đã viết:
Application.InputBox quét quet chọn đếm đối tượng. Dữ liệu cột L là số chết copy ra ngoài để lưu phòng trường hợp quét nhầm 9 thành 11 chắc là được

Với trình độ lười làm thủ công của bạn thì "chắc không được".
Bạn không hiểu lô gic vấn đề khi bị sai.
Nếu bạn chọn 11 thay vì 10 ô, sau khi code chạy xong thì bạn chỉ có thể dùng thủ công vãn hồi. Nhưng đó là nếu bạn có cách để biết là mình chọn dư 1 ô.
Theo yêu cầu của bạn, code sẽ chép chồng kết quả lên số ô trên cột L, lấp mất dữ liệu cũ. Do tính toán giản dị cho nên muốn lấy lại cũng không khó.
Bây giờ vấn đề chính của bạn là làm cách nào để biết trước đó mình chọn bao nhiêu ô?

vova2209 · 2/5/23

SA_DQ đã viết:

Bạn thử với con macro này xem sao:

PHP:

Sub TinhTrungBinhVaChep()
 Dim Rng As Range, WF As Object
 Dim Rws As Long, TB As Double, J As Long
 
 Rws = Cells(999999, "U").End(xlUp).Row
 Set WF = Application.WorksheetFunction
 For J = 1 To Rws
    With Cells(J, "R")
        If .Value <> "" Then
            Set Rng = .Offset(, 3).CurrentRegion
            TB = WF.Sum(Rng) / Rng.Cells.Count
            .Offset(, -6).Resize(Rng.Cells.Count).Value = TB
        End If
    End With
 Next J
End Sub

Em gửi lại file excel có đường links. và diễn đạt lại ý cần sử lý. mong anh giúp đỡ

Bài đã được tự động gộp: 2/5/23

VetMini đã viết:
Tôi chắc chắn là do bạn hồi nào giờ ít làm thủ công. Cứ thấy công việc dài 1 chút là lên GPE xin code giải quyết.
Tôi rất ít khi dùng macro. Vì vậy tôi xử lý các thao tác file Excel nhanh như mấy bạn trẻ bấm text trên phone.

Với trình độ lười làm thủ công của bạn thì "chắc không được".
Bạn không hiểu lô gic vấn đề khi bị sai.
Nếu bạn chọn 11 thay vì 10 ô, sau khi code chạy xong thì bạn chỉ có thể dùng thủ công vãn hồi. Nhưng đó là nếu bạn có cách để biết là mình chọn dư 1 ô.
Theo yêu cầu của bạn, code sẽ chép chồng kết quả lên số ô trên cột L, lấp mất dữ liệu cũ. Do tính toán giản dị cho nên muốn lấy lại cũng không khó.
Bây giờ vấn đề chính của bạn là làm cách nào để biết trước đó mình chọn bao nhiêu ô?

Em làm thủ công nhiều to tay quá nên mới lên nhờ anh chị giúp đỡ đấy ạ, chứ không phải như ảnh có 2 đoạn dữ liệu đâu ạ.
Đường hợp dễ bị nhầm như đã nêu ra thì tạo 1 cột phụ sau khi chuẩn rồi thì copy thủ công 1 lệnh vào là được ạ
Anh chị xem file em đã sử lý bằng thủ công đây ạ, làm mỗi lần như này lâu lắm ạ.
file excel đính kèm bên dưới đấy ạ

HieuCD · 2/5/23

vova2209 đã viết:
Anh chị viết giúp em code với dữ liệu như hình dưới:
Tại ô active R1 = -0.62 chia cho (Application.InputBox quét L1:L10 đếm được 10 ô có dữ liệu)
R1 = -0.62/10 = -0.062 => sau đó L1 - -0.062, L2 - -0.062.... L10 - -0.062
Kết quả như ở cột U

"Làm nhiều sai nhiều, làm ít sai ít, nếu không muốn sai thì không làm"
Không nên quét tay vùng dữ liệu, việv nầy nên giao cho code làm
Chỉ gợi ý, mình không viết code

vova2209 · 2/5/23

VetMini đã viết:
Bây giờ vấn đề chính của bạn là làm cách nào để biết trước đó mình chọn bao nhiêu ô

Em nghĩ dùng hàm đếm xong quét vùng dữ liệu thì sẽ ra được số lượng ô cần chia

SA_DQ · 3/5/23

PHP:

Sub TinhTrungBinhVaChepDe()
 Dim Rng As Range, WF As Object
 Dim Rws As Long, TB As Double, J As Long, Dg As Long
 
 Rws = Cells(999999, "U").End(xlUp).Row
 Set WF = Application.WorksheetFunction
 For J = 1 To Rws
    With Cells(J, "R")
        If .Value <> "" Then
'            Set Rng = .Offset(, 3).CurrentRegion   '
            Dg = .Offset(, 3).CurrentRegion.Rows.Count
            Set Rng = .Offset(, 3).Resize(Dg)
            TB = WF.Sum(Rng) / Rng.Cells.Count
            .Offset(, -6).Resize(Dg).Value = TB
        End If
    End With
 Next J
End Sub

vova2209 · 3/5/23

SA_DQ đã viết:

PHP:

Sub TinhTrungBinhVaChepDe()
 Dim Rng As Range, WF As Object
 Dim Rws As Long, TB As Double, J As Long, Dg As Long
 
 Rws = Cells(999999, "U").End(xlUp).Row
 Set WF = Application.WorksheetFunction
 For J = 1 To Rws
    With Cells(J, "R")
        If .Value <> "" Then
'            Set Rng = .Offset(, 3).CurrentRegion   '
            Dg = .Offset(, 3).CurrentRegion.Rows.Count
            Set Rng = .Offset(, 3).Resize(Dg)
            TB = WF.Sum(Rng) / Rng.Cells.Count
            .Offset(, -6).Resize(Dg).Value = TB
        End If
    End With
 Next J
End Sub

Không phải rồi anh ạ! kết quả không phải là trung bình, mà là số dư chia đều ra thành 10 phần xong lấy dữ liệu cột L trừ đi như ở bài #6

SA_DQ · 3/5/23

Mình cứ tưởng yêu cầu bài #1 & cấu trúc có khác tí mới vậy;
Còn giờ thì mình nản rồi!./.

vova2209 · 3/5/23

SA_DQ đã viết:
Mình cứ tưởng yêu cầu bài #1 & cấu trúc có khác tí mới vậy;
Còn giờ thì mình nản rồi!./.

Vâng em cảm ơn anh! em đang ngồi mò làm ạ, mắc đến đâu em đưa anh giúp em nhé

vova2209 · 3/5/23

Anh chị cho em hỏi hàm offset lấy theo tên cột làm như nào ạ:
Sub OSet()
ActiveCell = ActiveCell.Offset(, -3)
End Sub

bebo021999 · 3/5/23

Một cách làm gợi ý cho bạn: Sự kiện double click trên cell nào đó sẽ chọn vùng liên quan và thực hiện tác vụ:
Nếu cột L có n vùng thì bạn sẽ phải chạy code này n lần

VD:
Double click L2 (cột thứ 12) : code sẽ chọn vùng L1:L10 (vùng liên tục không có dòng trống), sau khi tính toán sẽ paste giá trị vào cột U (cột thứ 21), từ ô U1
Double click U2 (cột thứ 21) : code sẽ chọn vùng U1:U10, sau khi tính toán sẽ paste value giá trị vào cột L (cột thứ 12)

(Chuột phải vào sheet1, viewCode, sau đó dán code này vô)

PHP:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rng As Range, val As Range, cell As Range, sodong As Double
Cancel = True
If Target.Column = 21 And Not IsEmpty(Target) Then
    Range(Target.End(xlUp), Target.End(xlDown)).Select
    If MsgBox("Ban co muon copy vung da chon vao cot L khong?", vbYesNo) = vbNo Then Exit Sub
    Selection.Copy
    Selection.Offset(, -9).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
If Target.Column = 12 And Not IsEmpty(Target) Then
    Range(Target.End(xlUp), Target.End(xlDown)).Select
    If MsgBox("Ban co muon tinh toan tren vung chon nay khong?", vbYesNo) = vbNo Then Exit Sub
    Set rng = Selection
    Set val = rng.Cells(1, 1).Offset(, 6)
    If val.Value = "" Or Not IsNumeric(val) Then
        MsgBox "Khong tim thay gia tri tai cot R hoac gia tri nay khong hop le!"
        Exit Sub
    End If
    sodong = WorksheetFunction.CountA(rng)
    For Each cell In rng
        If Not IsEmpty(cell) Then Cells(cell.Row, "U").Value = cell - val / sodong
    Next
End If
Application.CutCopyMode = False
End Sub

Bài đã được tự động gộp: 3/5/23

vova2209 đã viết:
Anh chị cho em hỏi hàm offset lấy theo tên cột làm như nào ạ:
Sub OSet()
ActiveCell = ActiveCell.Offset(, -3)
End Sub

Nếu bạn muốn di chuyển đến cột C, cùng hàng với ô hiện tại thì không cần dùng offset nhé, chỉ cần thế này:

PHP:

Cells(ActiveCell.Row,"C").Select

vova2209 · 3/5/23

bebo021999 đã viết:
Một cách làm gợi ý cho bạn: Sự kiện double click trên cell nào đó sẽ chọn vùng liên quan và thực hiện tác vụ:
Nếu cột L có n vùng thì bạn sẽ phải chạy code này n lần

VD:
Double click L2 (cột thứ 12) : code sẽ chọn vùng L1:L10 (vùng liên tục không có dòng trống), sau khi tính toán sẽ paste giá trị vào cột U (cột thứ 21), từ ô U1
Double click U2 (cột thứ 21) : code sẽ chọn vùng U1:U10, sau khi tính toán sẽ paste value giá trị vào cột L (cột thứ 12)

(Chuột phải vào sheet1, viewCode, sau đó dán code này vô)

PHP:

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim rng As Range, val As Range, cell As Range, sodong As Double Cancel = True If Target.Column = 21 And Not IsEmpty(Target) Then Range(Target.End(xlUp), Target.End(xlDown)).Select If MsgBox("Ban co muon copy vung da chon vao cot L khong?", vbYesNo) = vbNo Then Exit Sub Selection.Copy Selection.Offset(, -9).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If If Target.Column = 12 And Not IsEmpty(Target) Then Range(Target.End(xlUp), Target.End(xlDown)).Select If MsgBox("Ban co muon tinh toan tren vung chon nay khong?", vbYesNo) = vbNo Then Exit Sub Set rng = Selection Set val = rng.Cells(1, 1).Offset(, 6) If val.Value = "" Or Not IsNumeric(val) Then MsgBox "Khong tim thay gia tri tai cot R hoac gia tri nay khong hop le!" Exit Sub End If sodong = WorksheetFunction.CountA(rng) For Each cell In rng If Not IsEmpty(cell) Then Cells(cell.Row, "U").Value = cell - val / sodong Next End If Application.CutCopyMode = False End Sub

Bài đã được tự động gộp: 3/5/23

Nếu bạn muốn di chuyển đến cột C, cùng hàng với ô hiện tại thì không cần dùng offset nhé, chỉ cần thế này:

PHP:

Cells(ActiveCell.Row,"C").Select

Vâng em cảm ơn nhiều ạ

vova2209 · 3/5/23

bebo021999

Cho em hỏi lệnh trên VBA để cộng biểu thức ra được như ở cột B ạ

vova2209 · 3/5/23

Sub Mafia_KLThieu_VBA()
Dim WF As Object
Dim RngCountA_K95 As Range
Dim DataCountA As Long
Dim i As Long

On Error Resume Next
Set WF = Application.WorksheetFunction
Set RngCountA_K95 = Application.InputBox("CountA vung data:", Type:=8)
DataCountA = WF.CountA(RngCountA_K95)

'ActiveCell.Offset(, 1) = ActiveCell.Value / DataCountA
SoDuK95 = ActiveCell.Value / DataCountA

For i = 1 To DataCountA
ActiveCell.OffSet(i - 1, 3) = SoDuK95
ActiveCell.OffSet(i - 1, 4) = Cells(ActiveCell.Row + i - 1, "L")
ActiveCell.OffSet(i - 1, 2) = "=RC[1]+RC[2]"
'Cells(ActiveCell.Row + i - 1, "L") = Cells(ActiveCell.Row + i - 1, "BC") 'Copy nguoc lai Côt L
Next i
End Sub

Em viết xong đoạn code để chạy rồi, anh chị xem hộ em thu gọn lại code với ạ

SA_DQ · 4/5/23

vova2209 đã viết:
Em viết xong đoạn code để chạy rồi, anh chị xem hộ em thu gọn lại code với ạ

(1) Phần khai báo các biến :

Mã:

    Dim WF As Object, RngCountA_K95 As Range
    Dim DataCountA As Long, I As Long

(Thu lại này nhắm áp dụng cho 1 chương trình có (rất) nhiều câu lệnh;
Tuy nhiên bạn cần khai báo thêm kiểu loại của tham biến như: SoDuK95

(2) Bạn đã thận trọng chưa, khi xài câu lệnh: On Error Resume Next
(/ới mình thì không bao giờ xài câu lệnh này bằng cách như vậy;
Ví dụ nên là vầy:

PHP:

    On Error GoTo LoiCT
    Set WF = Application.WorksheetFunction
'
 ' Các Câu lệnh  tiếp theo''
' . . . . . ..'   
Err_:           Exit Sub
LoiCT:
    If Err = 13 Then
        Resume Next
    Else
        GoTo Err_
    End If
End Sub

Chúc các bạn có tuần làm việc kết quả cao!

vova2209 · 4/5/23

SA_DQ đã viết:
(1) Phần khai báo các biến :

Mã:

Dim WF As Object, RngCountA_K95 As Range Dim DataCountA As Long, I As Long

(Thu lại này nhắm áp dụng cho 1 chương trình có (rất) nhiều câu lệnh;
Tuy nhiên bạn cần khai báo thêm kiểu loại của tham biến như: SoDuK95

(2) Bạn đã thận trọng chưa, khi xài câu lệnh: On Error Resume Next
(/ới mình thì không bao giờ xài câu lệnh này bằng cách như vậy;
Ví dụ nên là vầy:

PHP:

On Error GoTo LoiCT Set WF = Application.WorksheetFunction ' ' Các Câu lệnh tiếp theo'' ' . . . . . ..' Err_: Exit Sub LoiCT: If Err = 13 Then Resume Next Else GoTo Err_ End If End Sub

Chúc các bạn có tuần làm việc kết quả cao!

Em chạy code ko thấy lỗi nên mới cho on error resume next. Vâng cảm ơn anh ạ

Bài đã được tự động gộp: 4/5/23

SA_DQ đã viết:
(1) Phần khai báo các biến :

Mã:

Dim WF As Object, RngCountA_K95 As Range Dim DataCountA As Long, I As Long

(Thu lại này nhắm áp dụng cho 1 chương trình có (rất) nhiều câu lệnh;
Tuy nhiên bạn cần khai báo thêm kiểu loại của tham biến như: SoDuK95

(2) Bạn đã thận trọng chưa, khi xài câu lệnh: On Error Resume Next
(/ới mình thì không bao giờ xài câu lệnh này bằng cách như vậy;
Ví dụ nên là vầy:

PHP:

On Error GoTo LoiCT Set WF = Application.WorksheetFunction ' ' Các Câu lệnh tiếp theo'' ' . . . . . ..' Err_: Exit Sub LoiCT: If Err = 13 Then Resume Next Else GoTo Err_ End If End Sub

Chúc các bạn có tuần làm việc kết quả cao!

Anh cho em hỏi dùng hàm như nào để cộng biểu thức bằng vba. Bài #16 em hỏi ạ

SA_DQ · 4/5/23

vova2209 đã viết:
(2) Em chạy code ko thấy lỗi nên mới cho on error resume next. Vâng cảm ơn anh ạ
(1) Anh cho em hỏi dùng hàm như nào để cộng biểu thức bằng vba. Bài #16 em hỏi ạ

(1) Hình như bạn đã viết xong đoạn Code để chạy rồi mà! . . . .

(2) Hiện tại chạy không lỗi có nghĩa là tương lai không lỗi
Ví dụ trong chương trình của bạn có phép chia, phải không?
Vậy khi gặp phép chia cho 0, nó sẽ bỏ qua hay giận dỗi sao nữa đây?

Nhờ viết code cộng với số dư trung bình

Thành viên tích cực

File đính kèm

Ăn cùng góc phố

Thành viên tích cực

/(hông là gì!

Ăn cùng góc phố

Thành viên tích cực

File đính kèm

Chuyên gia GPE

Thành viên tích cực

/(hông là gì!

Thành viên tích cực

/(hông là gì!

Thành viên tích cực

Thành viên tích cực

Thành viên gạo cội

File đính kèm

Thành viên tích cực

Thành viên tích cực

bebo021999​

Thành viên tích cực

File đính kèm

/(hông là gì!

Thành viên tích cực

/(hông là gì!

Facebook

Group

bebo021999