Chuyển qua macro có đối số (1 người xem)

[overnight_9]

hi các anh chị & thầy Concogia & thầy NDU.
Trước đây thầy Co có giúp em đoạn code sự kiện selectionchange.
em muốn đoạn code này chuyển qua macro có đối số để em đưa vào add-ins sữ dụng chung. vậy nhờ các anh chị và thầy giúp em khai thêm vài biến nữa. em cảm ơn nhiều

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Vung, I, J, kK, Mg, TachDm, TachMau, Tong, K, A, B
    If Not Intersect(Target, Range([K132], [K10000].End(xlUp))) Is Nothing Or Not Intersect(Target, Range([AI132], [AI10000].End(xlUp))) Is Nothing Then
   If ActiveCell.Interior.ColorIndex = 6 Then
    UserForm1.Show
    Else
    Vung = ActiveCell.Offset(, -3).Resize(, 14)
        Tong = Tong + Len(ActiveCell) - Len(Replace(ActiveCell, "+", "")) + 1
        ReDim Mg(1 To Tong, 1 To 7)
                TachDm = Split(ActiveCell, "+")
                TachMau = Split(Vung(1, 1), "/")
                For J = LBound(TachDm) To UBound(TachDm)
                    K = K + 1
                On Error GoTo Lôi
                      Mg(K, 1) = TachDm(J): Mg(K, 2) = TachMau(J): Mg(K, 3) = Vung(1, 12): Mg(K, 4) = Vung(1, 11): Mg(K, 5) = IIf(Mg(K, 3) = "M", 1 / Vung(1, 14), Vung(1, 14)): Mg(K, 6) = Range("AJ108"): Mg(K, 7) = Range("P112")
                      
                    Next J
    ActiveCell.Interior.ColorIndex = 6
 Dim Ws As Worksheet
    Set Ws = Application.Workbooks("TH_chitiet.xls").Worksheets("TH_chitiet")
    With Ws.[B1000].End(xlUp)(2)
        If .Row = 7 Then
            .Offset(, -1) = 1
        Else
            .Offset(, -1) = 1 + Application.WorksheetFunction.Max(Ws.Range((Ws.[B5]), (Ws.[B10000].End(xlUp))).Offset(, -1))
        End If
    End With
    Ws.[B1000].End(xlUp)(2).Resize(K, 7) = Mg
    Application.Workbooks("TH_chitiet").Save
    Ws.Select
    
    End If
    End If
    
    Set Ws = Nothing
Exit Sub
Lôi:  If (Mg(K, 2) = Empty) Or (Mg(K, 3) = Empty) Or (Mg(K, 4) = Empty) Or (Mg(K, 5) = Empty) Then
         UserForm2.Show
      End If
End Sub

 

[ThuNghi]

hi các anh chị & thầy Concogia & thầy NDU.
Trước đây thầy Co có giúp em đoạn code sự kiện selectionchange.
em muốn đoạn code này chuyển qua macro có đối số để em đưa vào add-ins sữ dụng chung. vậy nhờ các anh chị và thầy giúp em khai thêm vài biến nữa. em cảm ơn nhiều

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Vung, I, J, kK, Mg, TachDm, TachMau, Tong, K, A, B
    If Not Intersect(Target, Range([K132], [K10000].End(xlUp))) Is Nothing Or Not Intersect(Target, Range([AI132], [AI10000].End(xlUp))) Is Nothing Then
   If ActiveCell.Interior.ColorIndex = 6 Then
    UserForm1.Show
    Else
    Vung = ActiveCell.Offset(, -3).Resize(, 14)
        Tong = Tong + Len(ActiveCell) - Len(Replace(ActiveCell, "+", "")) + 1
        ReDim Mg(1 To Tong, 1 To 7)
                TachDm = Split(ActiveCell, "+")
                TachMau = Split(Vung(1, 1), "/")
                For J = LBound(TachDm) To UBound(TachDm)
                    K = K + 1
                On Error GoTo Lôi
                      Mg(K, 1) = TachDm(J): Mg(K, 2) = TachMau(J): Mg(K, 3) = Vung(1, 12): Mg(K, 4) = Vung(1, 11): Mg(K, 5) = IIf(Mg(K, 3) = "M", 1 / Vung(1, 14), Vung(1, 14)): Mg(K, 6) = Range("AJ108"): Mg(K, 7) = Range("P112")
                      
                    Next J
    ActiveCell.Interior.ColorIndex = 6
 Dim Ws As Worksheet
    Set Ws = Application.Workbooks("TH_chitiet.xls").Worksheets("TH_chitiet")
    With Ws.[B1000].End(xlUp)(2)
        If .Row = 7 Then
            .Offset(, -1) = 1
        Else
            .Offset(, -1) = 1 + Application.WorksheetFunction.Max(Ws.Range((Ws.[B5]), (Ws.[B10000].End(xlUp))).Offset(, -1))
        End If
    End With
    Ws.[B1000].End(xlUp)(2).Resize(K, 7) = Mg
    Application.Workbooks("TH_chitiet").Save
    Ws.Select
    
    End If
    End If
    
    Set Ws = Nothing
Exit Sub
Lôi:  If (Mg(K, 2) = Empty) Or (Mg(K, 3) = Empty) Or (Mg(K, 4) = Empty) Or (Mg(K, 5) = Empty) Then
         UserForm2.Show
      End If
End Sub

Với code trên mà chuyển sang AddIns thì hơi phức tạp vì không tổng quát.
Nếu có file thì có thể từng bước chuyển thử. Nhìn code thì thua.

 

[overnight_9]

Với code trên mà chuyển sang AddIns thì hơi phức tạp vì không tổng quát.
Nếu có file thì có thể từng bước chuyển thử. Nhìn code thì thua.

Cám ơn ThuNghi,

mình đính kèm file nè, giúp mình tí với

 

[overnight_9]

Với code trên mà chuyển sang AddIns thì hơi phức tạp vì không tổng quát.
Nếu có file thì có thể từng bước chuyển thử. Nhìn code thì thua.

Nếu không đổi được các biến trong worksheet_selectionchange thì có thể tạo macro mới khi kích hoạt sẽ tự động copy đoạn code của worksheet_selectionchange & 2 Forms trong file này dán cho cất cả các sheets của 1 workbook bất kỳ, sao khi thực hiện xong yêu cầu rồi xoá đi được không các anh chị?

Hôm qua em có nghiên cứu và học các thầy 1 cách.
lập lại các biến như sau:

Private Sub AAA(ByVal Target As Range, ByVal giao1 As Range, ByVal giao2 As Range)
Dim Vung, I, J, kK, Mg, TachDm, TachMau, Tong, K, A, B
    If Not Intersect(Target, giao1) Is Nothing Or Not Intersect(Target, giao2) Is Nothing Then
   If ActiveCell.Interior.ColorIndex = 6 Then
    UserForm1.Show
.................
end sub

đây là 1 sub mới và cho vào add-ins để gọi sub này cũng tạo thêm 1 sự kiện selectionchange như sau;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vunggiao1 As Range
    vunggiao1 = Range([K132], [K10000].End(xlUp))
Dim vunggiao2 As Range
    vunggiao2 = Range([AI132], [AI10000].End(xlUp))
    
AAA Target, vunggiao1, vunggiao2
End Sub

nhưng khi kích hoạt gọi sub AAA thì code báo lỗi không nhận dạng được sub AAA.

em bí quá nhờ các thầy & anh chị giúp đỡ, em cám ơn nhiều.

 

[ndu96081631]

Nếu không đổi được các biến trong worksheet_selectionchange thì có thể tạo macro mới khi kích hoạt sẽ tự động copy đoạn code của worksheet_selectionchange & 2 Forms trong file này dán cho cất cả các sheets của 1 workbook bất kỳ, sao khi thực hiện xong yêu cầu rồi xoá đi được không các anh chị?

Hôm qua em có nghiên cứu và học các thầy 1 cách.
lập lại các biến như sau:

Private Sub AAA(ByVal Target As Range, ByVal giao1 As Range, ByVal giao2 As Range)
Dim Vung, I, J, kK, Mg, TachDm, TachMau, Tong, K, A, B
    If Not Intersect(Target, giao1) Is Nothing Or Not Intersect(Target, giao2) Is Nothing Then
   If ActiveCell.Interior.ColorIndex = 6 Then
    UserForm1.Show
.................
end sub

đây là 1 sub mới và cho vào add-ins để gọi sub này cũng tạo thêm 1 sự kiện selectionchange như sau;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vunggiao1 As Range
    vunggiao1 = Range([K132], [K10000].End(xlUp))
Dim vunggiao2 As Range
    vunggiao2 = Range([AI132], [AI10000].End(xlUp))
    
AAA Target, vunggiao1, vunggiao2
End Sub

nhưng khi kích hoạt gọi sub AAA thì code báo lỗi không nhận dạng được sub AAA.

em bí quá nhờ các thầy & anh chị giúp đỡ, em cám ơn nhiều.

Bạn thử bỏ chữ Private ở trước Sub AAA xem! Đồng thời Sub AAA này phải cho vào 1 Module nhé

 

[overnight_9]

Bạn thử bỏ chữ Private ở trước Sub AAA xem! Đồng thời Sub AAA này phải cho vào 1 Module nhé

hi anh NDU, em có vọc và làm cách này rồi chuyển sub AAA qua 1 module nhưng macro chỉ được ở file gốc (ý là làm việc trên file gốc), khi chuyển qua (*.xla) đưa vào add-ins móc ra sữ dụng cho workbook khác cũng có định dạng giống vậy & cũng xuất dữ liệu đúng đường dẫn, thì không nhận dạng được macro AAA.

vậy có thể làm theo cách này đươc không anh NDU?

Nếu không đổi được các biến trong worksheet_selectionchange thì có thể tạo macro mới khi kích hoạt sẽ tự động copy đoạn code của worksheet_selectionchange & 2 Forms trong file này dán cho cất cả các sheets của 1 workbook bất kỳ, sao khi thực hiện xong yêu cầu rồi xoá đi code & forms

 

[overnight_9]

Cuối cùng cũng thành công 1 chú macro, 3 đêm 2 ngày mò mò vọc vọc, nhờ biết tí English và thầy cho 1 link trang web nước ngoài ngồi ngâm cứu hoá ra lại đươc. HIC