Nhờ anh chị viết VBA tính toán

[soap1234]

Nhờ chị viết em vba như sau: nếu cột nào có giá trị sau: [hoten], [tobando], [sothua] thì tự động tính toán ra phần kết quả trên

 

[befaint]

Để trỏ chuột vào cell F3 rồi nhấn Ctrl + E là mọi thứ xong. Không công thức, không cốt cao gì cả.

 

[soap1234]

em muốn nhờ viết 1 code để tự động tính toán anh à

 

[befaint]

tự động tính toán

Flash Fill của Excel là siêu siêu cấp của tự động ấy chứ. Bạn viết code xong rồi cũng phải ấn nút, gõ tên hàm các kiểu.

 

[BuiQuangThuan]

tự động tính toán

Có vẻ hơi lạm dụng VBA

 

[namvu230397]

Có vẻ hơi lạm dụng VBA

Cứ phải phức tạp hoá quá làm gì trong khi các công cụ excel đã có sẵn, nhiều khi các công cụ có sẵn còn tiện và nhanh hơn VBA nhiều mà

 

[soap1234]

không phải em lạm dụng anh à tại vì em đang muốn tạo một addin cho người dùng sau này khi người dùng mở addin lên họ sẽ khởi tạo cơ sỡ dữ liệu .không chả biết đâu mà lần các anh à, mong các anh guips em code với, em xin chân thành cảm ơn

 

[Phuocam]

Khách hàng không chịu dùng "Flash Fill" rồi, phải dùng VBA để tạo addin . Hahaha ...


.

 

[johnnylinhanh]

Không biết ý đồ của bạn là gì vì mình thấy hơi lạ là trong file có sẵn 1 đoạn code VBA, chỉnh sửa xíu là ra cái bạn cần rồi mà nhỉ?

Sub dongcuoi()
Dim ws As Worksheet
    Dim lg  As Long
    lg = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To lg
        Sheet1.Range("F2").Formula = "=CONCATENATE(A2,""_"",B2,""_"",D2)"
        Sheet1.Range("F2:E" & lg).FillDown
     Next
End Sub

 

[soap1234]

dạ em mục đích của em là code tự tính toán khi mình có tiêu đề : [hoten], [tobando], [sothua] tránh trường hợp sau này khi mình chèn cột xóa cột thì công thức khi nào cũng ở cuối cột đó và dự vào tiêu đề : [hoten], [tobando], [sothua] để tính toán
mong anh chị code em với. em cảm ơn nhiều ạ

 

[johnnylinhanh]

Bạn thử code này xem đúng mục đích chưa nhé. Mặc định là dòng 1 sẽ là dòng tiêu đề cột và cột cuối cùng luôn là cột Kết quả

Sub gpe()
Dim c1&, c2&, c3&, r&, s$
On Error Resume Next
c1 = Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[hoten]", , , 1).Column
c2 = Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[tobando]", , , 1).Column
c3 = Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[sothua]", , , 1).Column
If c1 = 0 Or c2 = 0 Or c3 = 0 Then
    s = Application.Trim(IIf(c1 = 0, "[hoten] ", "") & IIf(c2 = 0, "[tobando] ", "") & IIf(c3 = 0, "[sothua] ", ""))
    MsgBox "Kiem tra cot: " & s, vbOKOnly, "Canh bao"
Else
    r = Sheet1.Cells(1048576, c1).End(xlUp).Row - 1
    If r > 0 Then
        ReDim Arr(1 To r, 1 To 1)
        For i = 1 To r
            Arr(i, 1) = Sheet1.Cells(i + 1, c1) & "_" & Sheet1.Cells(i + 1, c2) & "_" & Sheet1.Cells(i + 1, c3)
        Next i
        Sheet1.Cells(2, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Resize(r, 1).Value = Arr
    End If
End If
End Sub

 

[soap1234]

Quá tuyệt vời anh à.
mà anh ơi nhờ anh sửa code của anh để luôn luôn lấy cột cuối cùng cho dù mình chèn dòng xóa dòng vẫn không ảnh hưởng em với


Sub dongcuoi()
Dim ws As Worksheet
Dim lg As Long
lg = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lg
Sheet1.Range("F2").Formula = "=CONCATENATE(A2,""_"",B2,""_"",D2)"
Sheet1.Range("F2:E" & lg).FillDown
Next
End Sub

 

[johnnylinhanh]

Bạn thử code sau để giữ lại công thức như file bạn có ban đầu nhé

Sub gpe()
Dim c1$, c2$, c3$, s$, r&
On Error Resume Next
c1 = Replace(Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[hoten]", , , 1).Address(0, 0), 1, "") & "2"
c2 = Replace(Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[tobando]", , , 1).Address(0, 0), 1, "") & "2"
c3 = Replace(Sheet1.Cells(1, 1).Resize(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Find("[sothua]", , , 1).Address(0, 0), 1, "") & "2"
If c1 = "" Or c2 = "" Or c3 = "" Then
    s = Application.Trim(IIf(c1 = "", "[hoten] ", "") & IIf(c2 = "", "[tobando] ", "") & IIf(c3 = "", "[sothua] ", ""))
    MsgBox "Kiem tra cot: " & s, vbOKOnly, "Canh bao"
Else
    r = Sheet1.Cells(1048576, Replace(c1, "2", "")).End(xlUp).Row - 1
    If r > 0 Then
        Sheet1.Cells(2, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Formula = "=CONCATENATE(" & c1 & ",""_""," & c2 & ",""_""," & c3 & ")"
        Sheet1.Cells(2, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column).Resize(r, 1).FillDown
    End If
End If
End Sub

 

[soap1234]

Quá tuyệt vời anh à. không biết nói gì hơn
em thấy code của anh ngắn gọn không cần tiêu đề nữa nhờ anh sửa code chèn vào cột cuối cho dù mình chèn dòng xóa dòng vẫn không ảnh hưởng
code của anh nhờ anh sửa lại tý ạ

Sub dongcuoi()
Dim ws As Worksheet
Dim lg As Long
lg = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lg
Sheet1.Range("F2").Formula = "=CONCATENATE(A2,""_"",B2,""_"",D2)"
Sheet1.Range("F2:E" & lg).FillDown
Next
End Sub

 

[BuiQuangThuan]

Bạn thử code sau để giữ lại công thức như file bạn có ban đầu nhé

Nếu dòng tiêu đề mà lặp lại từ 2 cái điều kiện giống nhau thì Find có vẻ hoạt động không đúng

 

[VetMini]

Nếu dòng tiêu đề mà lặp lại từ 2 cái điều kiện giống nhau thì Find có vẻ hoạt động không đúng
...

Đã nói đến hai từ tiêu đề thì thiết tưởng cũng cần nhắc quý vị rằng tiêu đề của thớt này phạm quy nhé (tiêu đề chung chung)

Có vẻ hơi lạm dụng VBA

Có vẻ hơi lạm dụng các vị ham code.

 

[BuiQuangThuan]

Có vẻ hơi lạm dụng các vị ham code.

Bị lên cơn nghiện chú ạ. Giờ mới để ý tên chủ đề có vấn đề.

 

[soap1234]

Hì. có gì sai sót các anh chị thông cảm cho em với

 

[bongbay55]

Flash Fill của Excel là siêu siêu cấp của tự động ấy chứ. Bạn viết code xong rồi cũng phải ấn nút, gõ tên hàm các kiểu.

Hi, chiều em ấy chút đi

 

[soap1234]

Dạ em cảm ơn anh nhiều nhưng kết quả không đúng như không đúng công thức tạo ra . Hì