Hỏi cách Sử dụng 1 hàm cho nhiều cột, dùng Private Sub Worksheet_Change để ẩn hàm đi

chidung2009 · 12/8/16

Mình có 1 hàm, Hàm này có trong nhiều cột, hàm chỉ thay đổi chiếu diều kiện từ trên xuống dưới. Nhưng vì nếu copy hàm này ra thì file sẽ nặng,

Nên mình muốn sử dụng Private Sub Worksheet_Change trong VBA để sử dụng cho 1 loạt các cột đó.
Từ O7 : V18 đều có chung 1 hàm tính, chỉ có N7 là thay đổi từ trên xuống dưới.
Tại Ơ
=IF($N7="";"";INDEX(DanSu;MATCH($N7;IF($C$4 =1;DS_TK;DS_GQ)

;COLUMN()-10))

chidung2009 · 12/8/16

Có thể mình nói khó hiếu, nhưng các anh chị hiểu nô na là: Sử dụng VBA để các cột tự tính toán và hiện ra số liệu

HieuCD · 12/8/16

chidung2009 đã viết:
Mình có 1 hàm, Hàm này có trong nhiều cột, hàm chỉ thay đổi chiếu diều kiện từ trên xuống dưới. Nhưng vì nếu copy hàm này ra thì file sẽ nặng,

Nên mình muốn sử dụng Private Sub Worksheet_Change trong VBA để sử dụng cho 1 loạt các cột đó.
Từ O7 : V18 đều có chung 1 hàm tính, chỉ có N7 là thay đổi từ trên xuống dưới.
Tại Ơ
=IF($N7="";"";INDEX(DanSu;MATCH($N7;IF($C$4 =1;DS_TK;DS_GQ);COLUMN()-10))

bạn cho biết Change theo ô nào

chidung2009 · 12/8/16

HieuCD đã viết:
bạn cho biết Change theo ô nào

Change theo N7, còn các cột sẽ tự tính toán dựa theo hàm (O7 từ đó đến V7, xuống khoảng 200 hàng)
=IF($N7="";"";INDEX(DanSu;MATCH($N7;IF($C$4 =1;DS_TK;DS_GQ)

;COLUMN()-10))

quanluu · 12/8/16

chidung2009 đã viết:
Change theo N7, còn các cột sẽ tự tính toán dựa theo hàm (O7 từ đó đến V7, xuống khoảng 200 hàng)
=IF($N7="";"";INDEX(DanSu;MATCH($N7;IF($C$4 =1;DS_TK;DS_GQ);COLUMN()-10))

Ko hiểu ý bạn luôn.
Giá trị côt O->V dùng ct phụ thuộc ở cột N, nên khi cột N thay đổi thì sẽ điền giá trị cột O -> V
Vấn đề cột N ở đây lại dùng công thức nên dùng sự kiện Change là ko đc rùi.

chidung2009 · 12/8/16

Dùng công thức là không đc à, Nếu cột N7 không dùng công thức thì làm sao các ô từ O đến V cùng thay đổi theo N khi Change thay đổi. Mình đã làm. nhưng chỉ đc hàng P thôi.

Option Explicit

Private Sub Worksheet_Change()

If Not Intersect(Target, Union(Columns(4), Columns("N:N"))) Is Nothing Then
With Cells(Target.Row, 16)
.Value = "=IF(RC14="""","""",INDEX(DanSu,MATCH(RC14,IF(R4C3 =1,DS_TK,DS_GQ),),COLUMN()-10))"
.Value = .Value

End With
End If
End Sub

quanluu · 12/8/16

chidung2009 đã viết:
Dùng công thức là không đc à, Nếu cột N7 không dùng công thức thì làm sao các ô từ O đến V cùng thay đổi theo N khi Change thay đổi. Mình đã làm. nhưng chỉ đc hàng P thôi.

Option Explicit

Private Sub Worksheet_Change()

If Not Intersect(Target, Union(Columns(4), Columns("N:N"))) Is Nothing Then
With Cells(Target.Row, 16)
.Value = "=IF(RC14="""","""",INDEX(DanSu,MATCH(RC14,IF(R4C3 =1,DS_TK,DS_GQ),),COLUMN()-10))"
.Value = .Value

End With
End If
End Sub

Bạn thử với cái này

Mã:

"=IF($N" & target.Row & "=" & """""" & ";" & """""" & ";INDEX(DanSu;MATCH($N" & target.Row & ";IF($C$4 =1;DS_TK;DS_GQ););COLUMN()-10))"

HieuCD · 12/8/16

bỏ hết công thức thay đổi theo ô C4 hoặc vùng nào đó bạn tự thêm vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FistR As Integer, LastR As Integer
If Target.Address = "$C$4" Then
    If [C4] = 1 Then
    
        LastR = Range("A7:A500").Find(WorksheetFunction. _
            Max(Sheets("DanSu").Range("A7:A500")), LookIn:=xlValues).Row
        FistR = Range("A7:A500").Find(1, LookIn:=xlValues).Row
    Else
        LastR = Range("B7:B500").Find(WorksheetFunction. _
            Max(Sheets("DanSu").Range("B7:B500")), LookIn:=xlValues).Row
        FistR = Range("B7:B500").Find(1, LookIn:=xlValues).Row
    End If
    Range("N7:V500").ClearContents
    tmp = Sheets("DanSu").Range("D" & FistR & ":L" & LastR).Value
    Sheets("DanSu").Range("N7:V" & LastR - FistR + 7).Value = tmp
End If
End Sub

chidung2009 · 13/8/16

HieuCD đã viết:

bỏ hết công thức thay đổi theo ô C4 hoặc vùng nào đó bạn tự thêm vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FistR As Integer, LastR As Integer
If Target.Address = "$C$4" Then
    If [C4] = 1 Then
    
        LastR = Range("A7:A500").Find(WorksheetFunction. _
            Max(Sheets("DanSu").Range("A7:A500")), LookIn:=xlValues).Row
        FistR = Range("A7:A500").Find(1, LookIn:=xlValues).Row
    Else
        LastR = Range("B7:B500").Find(WorksheetFunction. _
            Max(Sheets("DanSu").Range("B7:B500")), LookIn:=xlValues).Row
        FistR = Range("B7:B500").Find(1, LookIn:=xlValues).Row
    End If
    Range("N7:V500").ClearContents
    tmp = Sheets("DanSu").Range("D" & FistR & ":L" & LastR).Value
    Sheets("DanSu").Range("N7:V" & LastR - FistR + 7).Value = tmp
End If
End Sub

Cảm ơn bạn đã giúp mình. Ý của mình bạn làm gần đúng rồi. Mình gửi lại file cho bạn làm trực tiếp trên nó luôn cho mình đễ hình dung. Do mình mới bắt đầu học nên gà mờ lắm.

Tại O7 -> V7 đều có hàm =IF($N7="";"";INDEX(DanSu;MATCH($N7;IF($M$3 =1;DS_TK;DS_GQ)

;COLUMN()-10))
Bạn viết code vba sao cho khi hàm đối chiếu vs cột N thì sẽ cho ra kết quả như bảng mình tô màu đỏ. Toàn bộ hàm từ N7->v7 sẽ thay đổi kết quả theo biến M3

Do sơ xuất nên hàm ở cột N chưa đc copy từ trên xuống dưới cột N 7 là đúng.
Bạn có thể thay đổi khoảng thời gian ở E2 và E3 để hiểu ý của mình. Bạn hãy viết code vba trong khung màu xanh và đỏ

HieuCD · 13/8/16

khi thay đổi ô E2:E3 hoặc M3 code sẽ chạy

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, ColDo As Integer, LastD As Integer, Darr, Arr()
If Not Intersect(Target, Union(Range("E2:E3"), Range("M3"))) Is Nothing Then
On Error Resume Next
    LastD = Sheets("Sheet1").Range("F7").End(xlDown).Row
    Darr = Sheets("Sheet1").Range("A7:L" & LastD)
    ReDim Arr(1 To LastD, 1 To 9)
    If Range("M3") = 1 Then
        ColDo = 1
        LastKQ = WorksheetFunction.Max(Sheets("Sheet1").Range("A7:A500"))
    Else
        ColDo = 2
        LastKQ = WorksheetFunction.Max(Sheets("Sheet1").Range("B7:B500"))
    End If
    Range("N7:V500").ClearContents
    For i = 1 To LastD
        If Darr(i, ColDo) <> "" Then
            n = n + 1
            Arr(n, 1) = n
            For j = 2 To 9
                Arr(n, j) = Darr(i, j + 3)
            Next
        If n = LastKQ Then Exit For
        End If
    Next
    Sheets("Sheet1").Range("N7").Resize(n, 9) = Arr
End If
End Sub

chidung2009 · 13/8/16

HieuCD đã viết:

khi thay đổi ô E2:E3 hoặc M3 code sẽ chạy

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, ColDo As Integer, LastD As Integer, Darr, Arr()
If Not Intersect(Target, Union(Range("E2:E3"), Range("M3"))) Is Nothing Then
On Error Resume Next
    LastD = Sheets("Sheet1").Range("F7").End(xlDown).Row
    Darr = Sheets("Sheet1").Range("A7:L" & LastD)
    ReDim Arr(1 To LastD, 1 To 9)
    If Range("M3") = 1 Then
        ColDo = 1
        LastKQ = WorksheetFunction.Max(Sheets("Sheet1").Range("A7:A500"))
    Else
        ColDo = 2
        LastKQ = WorksheetFunction.Max(Sheets("Sheet1").Range("B7:B500"))
    End If
    Range("N7:V500").ClearContents
    For i = 1 To LastD
        If Darr(i, ColDo) <> "" Then
            n = n + 1
            Arr(n, 1) = n
            For j = 2 To 9
                Arr(n, j) = Darr(i, j + 3)
            Next
        If n = LastKQ Then Exit For
        End If
    Next
    Sheets("Sheet1").Range("N7").Resize(n, 9) = Arr
End If
End Sub

Mình cảm ơn bạn nhiều

Hỏi cách Sử dụng 1 hàm cho nhiều cột, dùng Private Sub Worksheet_Change để ẩn hàm đi

chidung2009

Thành viên hoạt động

chidung2009

Thành viên hoạt động

HieuCD

Chuyên gia GPE

chidung2009

Thành viên hoạt động

quanluu

Thành viên gắn bó

chidung2009

Thành viên hoạt động

quanluu

Thành viên gắn bó

HieuCD

Chuyên gia GPE

chidung2009

Thành viên hoạt động

HieuCD

Chuyên gia GPE

chidung2009

Thành viên hoạt động

Bài viết mới nhất

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