Nhờ viết Code VBA thống kê các phép toán

sangucu1 · 5/1/21

Em chào các bác, lại là em đây ạ.
(Em cảm ơn các bác đã giúp em bài toán Code VBA transfer những con số ngẫu nhiên ạ).
Nay em có bài toán như thế này ạ, mong các bác giúp em với ạ (mục đích em dùng vào quản lý chăn nuôi gà đẻ trứng ạ).
-------
File đính kèm em mô tả đơn giản bài toán như sau:
- Khi em nhập dữ liệu lần 1 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C1.
- Khi em nhập dữ liệu lần 2 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C2.
- Khi em nhập dữ liệu lần 3 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C3.
---
- Khi em nhập dữ liệu lần n vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở Cn.

SA_DQ · 5/1/21

Bạn sẽ nhập các con số ở A(i( & B(i)
/(ết quả gì hiện ở các C(i)?

sangucu1 · 5/1/21

SA_DQ đã viết:
Bạn sẽ nhập các con số ở A(i( & B(i)
/(ết quả gì hiện ở các C(i)?

Chỉ ví dụ đơn giản là 1 phép nhân thôi bác ạ.

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

SA_DQ đã viết:
Bạn sẽ nhập các con số ở A(i( & B(i)
/(ết quả gì hiện ở các C(i)?

Chỉ nhập ở A1 và B1 thôi nhưng kết quả được thống kê từ C1 đến Cn
Giá trị n ở một giới hạn nào đó thì có Button để Reset và phép thống kê lại được thống kê từ C1 đến Cn bác ạ

VetMini · 5/1/21

Lỡ cần sửa thì nhấn cái gì?
Khi ghi và làm việc với dữ liệu, LUÔN LUÔN nghĩ đến lúc CẦN SỬA.

sangucu1 · 5/1/21

VetMini đã viết:
Lỡ cần sửa thì nhấn cái gì?
Khi ghi và làm việc với dữ liệu, LUÔN LUÔN nghĩ đến lúc CẦN SỬA.

- A1 và B1 là luôn luôn thay đổi từng ngày
- Cứ 1 tháng kiểm kê kho là lại reset lại C1-Cn
- Thế nên dẫu có sai thì chạy lại 1 tháng cũng nhanh thôi ạ
- Do đó ko cần sửa ạ
- Nhưng nếu cần sửa thì có thể thêm đoạn code để sửa được ko bác?
Em cảm ơn bác đã quan tâm và giúp em ạ

Hoàng Nhật Phương · 5/1/21

sangucu1 đã viết:
Em chào các bác, lại là em đây ạ.
(Em cảm ơn các bác đã giúp em bài toán Code VBA transfer những con số ngẫu nhiên ạ).
Nay em có bài toán như thế này ạ, mong các bác giúp em với ạ (mục đích em dùng vào quản lý chăn nuôi gà đẻ trứng ạ).
-------
File đính kèm em mô tả đơn giản bài toán như sau:
- Khi em nhập dữ liệu lần 1 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C1.
- Khi em nhập dữ liệu lần 2 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C2.
- Khi em nhập dữ liệu lần 3 vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở C3.
---
- Khi em nhập dữ liệu lần n vào A1 và B1 thì khi ấn vào Button1 kết quả sẽ hiển thị ở Cn.

Bạn thử để đoạn code sau trong module sheet1,rồi nhập liệu trong cột A & cột B:

Mã:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long, WF As WorksheetFunction
    With Me
        If Target.Column < 3 Then
            If .Cells(Target.Row, 1) <> Empty And _
               .Cells(Target.Row, 2) <> Empty Then
                Set WF = WorksheetFunction
                x = WF.Count(.Columns(1)) + WF.Count(.Columns(2))
                .Cells(Target.Row, 3) = x / 2
                Else
                .Cells(Target.Row, 3).Clear
            End If
        End If
    End With
End Sub

VetMini · 5/1/21

Hướng dẫn:
Button 1 nên thay tên lại là "Tinh cho lan n", với n thay đổi tuỳ theo bị trí của A, B lúc bạn nhập liệu.
Ví dụ bạn đã nhập 3 lần thì khi bạn nhập lần thứ 4, Button sẽ tự động thay "Tinh cho lan 4". Nếu bạn thay đổi dữ liệu ở lần 2 thì Button sẽ hiện "Tinh cho lan 2".
Như vậy, code sẽ tự động tính giùm cho bạn đúng vị trí ở cột C.

sangucu1 · 5/1/21

NHN_Phương đã viết:

Bạn thử để đoạn code sau trong module sheet1,rồi nhập liệu trong cột A & cột B:

Mã:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long, WF As WorksheetFunction
    With Me
        If Target.Column < 3 Then
            If .Cells(Target.Row, 1) <> Empty And _
               .Cells(Target.Row, 2) <> Empty Then
                Set WF = WorksheetFunction
                x = WF.Count(.Columns(1)) + WF.Count(.Columns(2))
                .Cells(Target.Row, 3) = x / 2
                Else
                .Cells(Target.Row, 3).Clear
            End If
        End If
    End With
End Sub

Ý em ko phải như code này ạ.

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

VetMini đã viết:
Hướng dẫn:
Button 1 nên thay tên lại là "Tinh cho lan n", với n thay đổi tuỳ theo bị trí của A, B lúc bạn nhập liệu.
Ví dụ bạn đã nhập 3 lần thì khi bạn nhập lần thứ 4, Button sẽ tự động thay "Tinh cho lan 4". Nếu bạn thay đổi dữ liệu ở lần 2 thì Button sẽ hiện "Tinh cho lan 2".
Như vậy, code sẽ tự động tính giùm cho bạn đúng vị trí ở cột C.

Vâng ạ, nhưng chỉ nhập liệu duy nhất ở 2 ô A1 và B1 và khi mỗi lần A1 và B1 thay đổi, ta ấn Button thì kết quả sẽ hiện lên ở cột C (lần lượt hiện từ C1 đến C31 sau mỗi tháng có nút Button để Reset để bắt đầu 1 tháng mới).

SA_DQ · 5/1/21

PHP:

Sub TinhTichA_B()
 Dim Rws As Long
 
 Rws = [C367].End(xlUp).Row
 If Rws > 1 Then Rws = Rws + 1
 Cells(Rws, "C").Value = [B1].Value * [A1].Value
End Sub

sangucu1 · 5/1/21

SA_DQ đã viết:
PHP:

Sub TinhTichA_B() Dim Rws As Long Rws = [C367].End(xlUp).Row If Rws > 1 Then Rws = Rws + 1 Cells(Rws, "C").Value = [B1].Value * [A1].Value End Sub

Cảm ơn bác, gần được rồi ạ
... Nhưng kết quả chỉ hiển thị ở C1
Em muốn sau mỗi lần nhập ở A1 và B1 thì các kết quả được thống kê lần lượt ở cột C bác ạ.
Tức là ngày thứ nhất nhập liệu vào A1 và B1 thì kết quả tính toán ra kết quả ở C1, ngày thứ 2 vẫn nhập liệu ở A1 và B1 nhưng kết quả sẽ hiện ở C2... cứ thế đến max 31 ngày

SA_DQ · 5/1/21

Thì bạn tự tìm cách sửa theo í mình đi!

Dạ nhưng em mù tịt bác ơi, các bác giúp em với

PHP:

Sub TinhTichA_B()
Dim Rws As Long

Rws = [C367].End(xlUp).Row + 1
Cells(Rws, "C").Value = [B1].Value * [A1].Value
[C1].Value = "Tính Tích"
End Sub

sangucu1 · 5/1/21

Dạ nhưng em mù tịt bác ơi, các bác giúp em với

Hoàng Nhật Phương · 5/1/21

sangucu1 đã viết:
Cảm ơn bác, gần được rồi ạ
... Nhưng kết quả chỉ hiển thị ở C1
Em muốn sau mỗi lần nhập ở A1 và B1 thì các kết quả được thống kê lần lượt ở cột C bác ạ.
Tức là ngày thứ nhất nhập liệu vào A1 và B1 thì kết quả tính toán ra kết quả ở C1, ngày thứ 2 vẫn nhập liệu ở A1 và B1 nhưng kết quả sẽ hiện ở C2... cứ thế đến max 31 ngày

Sửa lại theo gợi ý của Bác @VetMini , Bạn thử lại nhé:

Mã:

Option Explicit

Sub Macro1()
    Dim i As Integer, s As String, btn As Shape
    If Range("A1") <> Empty And Range("B1") <> Empty Then
        Set btn = ActiveSheet.Shapes("SoLan")
        s = btn.TextFrame.Characters.Text
        i = Mid(s, 13, Len(s) - 12)
        Range("C1").Value = i
        MsgBox i
        s = "Tinh cho lan "
        btn.TextFrame.Characters.Text = s & i + 1
    End If
End Sub

VetMini · 5/1/21

Đã không cần chỉnh sửa thì chơi code què vậy:

Private Sub Button1_Click()
' stupid procedure to calculate and place the product of A and B into C
With ActiveSheet
Set Rg = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row)).Resize( , 3)
End With
If IsEmpty(Rg.Cells(1, 2)) Then
MsgBox "You idiot, I can't calculate without suficient data" & vbNewLine & "Enter something in colum B"
Exit Sub
ElseIf Not IsEmpty(Rg.Cells(1, 3))
MsgBox "Ha ha, column C has already been calcutated !"
Exit Sub
End If
Rg.Cells(1, 1).Value = Rg.Cells(1, 2).Value * Rg.Cells(1, 3).Value
End Sub

sangucu1 · 5/1/21

SA_DQ đã viết:
Thì bạn tự tìm cách sửa theo í mình đi!

PHP:

Sub TinhTichA_B() Dim Rws As Long Rws = [C367].End(xlUp).Row + 1 Cells(Rws, "C").Value = [B1].Value * [A1].Value [C1].Value = "Tính Tích" End Sub

Đây rồi bác ơi, cảm ơn bác

)

Sub TinhTichA_B()
Dim Rws As Long
Rws = [C31].End(xlUp).Row + 1
If Rws > 1 Then Rws = Rws + 0
Cells(Rws, "C").Value = [B1].Value * [A1].Value
End Sub

Hoàng Nhật Phương · 5/1/21

VetMini đã viết:
Đã không cần chỉnh sửa thì chơi code què vậy:

Private Sub Button1_Click()
' stupid procedure to calculate and place the product of A and B into C
With ActiveSheet
Set Rg = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row)).Resize( , 3)
End With
If IsEmpty(Rg.Cells(1, 2)) Then
MsgBox "You idiot, I can't calculate without suficient data" & vbNewLine & "Enter something in colum B"
Exit Sub
ElseIf Not IsEmpty(Rg.Cells(1, 3))
MsgBox "Ha ha, column C has already been calcutated !"
Exit Sub
End If
Rg.Cells(1, 1).Value = Rg.Cells(1, 2).Value * Rg.Cells(1, 3).Value
End Sub

Bác ơi thiếu 'Then' ạ: ElseIf Not IsEmpty(Rg.Cells(1, 3)) ...

ptm0412 · 5/1/21

sangucu1 đã viết:
Tức là ngày thứ nhất nhập liệu vào A1 và B1 thì kết quả tính toán ra kết quả ở C1, ngày thứ 2 vẫn nhập liệu ở A1 và B1 nhưng kết quả sẽ hiện ở C2... cứ thế đến max 31 ngày

Mục đích cuối của chủ đề không biết đã tính đến việc nhập sai sửa lại chưa nhỉ? Nếu sai sửa lại:
- nhấn nút tính: cuối tháng sẽ không phải 31 mà là bốn năm chục
- Không nhấn nút tính: Cột C giữ kết quả sai hiện có

NHN_Phương đã viết:
Bác ơi thiếu 'Then' ạ: ElseIf Not IsEmpty(Rg.Cells(1, 3)) ...

Cái này khiến nghe mắng này

VetMini · 5/1/21

NHN_Phương đã viết:
Bác ơi thiếu 'Then' ạ: ElseIf Not IsEmpty(Rg.Cells(1, 3)) ...

Ừa thiếu thiệt. Code chữa cháy lười tét quá.

batman1 · 5/1/21

Mã:

Rws = [C31].End(xlUp).Row + 1

Nhấn Button lần đầu kết quả xuất hiện C2. Tức không đúng với yêu cầu bài 1. Và có nhấn tới Tết cũng chỉ có thể có 30 kết quả trong cột C. Không bao giờ có kết quả thứ 31.
Nhấn lần thứ 31, 32, ... thì chỉ C3 thay đổi liên tục.

Mã:

If Rws > 1 Then Rws = Rws + 0

Dòng trên làm gì? Thừa.

sangucu1 · 6/1/21

batman1 đã viết:
Mã:

Rws = [C31].End(xlUp).Row + 1

Nhấn Button lần đầu kết quả xuất hiện C2. Tức không đúng với yêu cầu bài 1. Và có nhấn tới Tết cũng chỉ có thể có 30 kết quả trong cột C. Không bao giờ có kết quả thứ 31.
Nhấn lần thứ 31, 32, ... thì chỉ C3 thay đổi liên tục.

Mã:

If Rws > 1 Then Rws = Rws + 0

Dòng trên làm gì? Thừa.

Chuẩn rồi bác, em đã sửa thành [32]
Còn nhấn lần đầu ra C2 tuy ko được như yêu cầu bài toán đặt ra nhưng code là sử dụng được vào mục đích rồi ạ.
Dòng thừa đó cũng là do em loay hoay muốn kết quả đầu nó ở C1 và kết quả cuối cùng nó ở C31 đồng thời ko được phép quay lại C1 khi chưa ấn Reset <=== Cái này em chưa làm được, bác hộ em cho code là hoàn hảo với ạ?

Sub TinhTichA_B()
Dim Rws As Long
Rws = [C32].End(xlUp).Row + 1
Cells(Rws, "C").Value = [B1].Value * [A1].Value
End Sub
------
Sub Reset()
Range("C2:C32").Select
Selection.ClearContents
End Sub

Nhờ viết Code VBA thống kê các phép toán

Thành viên mới

File đính kèm

/(hông là gì!

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Thành viên gắn bó

File đính kèm

Ăn cùng góc phố

Thành viên mới

/(hông là gì!

Thành viên mới

/(hông là gì!

Thành viên mới

Thành viên gắn bó

File đính kèm

Ăn cùng góc phố

Thành viên mới

Thành viên gắn bó

Bad Excel Member

Ăn cùng góc phố

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

Thành viên mới