Code vba thay thế công thức

[Phamvannhan1531]

Em có file excell sử dụng nhiều công thức hàm if ở các cột H, cột M, cột P. VÀ giá trị cột O bằng giá trị cột N. Em xin nhờ các a chị trong diễn đàn viết giúp em đoạn code để em có thể gán vào nút button để chạy công thức với ạ

 

[PacificPR]

Lại "Quá đơn giản" roài

 

[batman1]

Em có file excell sử dụng nhiều công thức hàm if ở các cột H, cột M, cột P. VÀ giá trị cột O bằng giá trị cột N. Em xin nhờ các a chị trong diễn đàn viết giúp em đoạn code để em có thể gán vào nút button để chạy công thức với ạ

Bạn tự kiểm tra

Sub doituong_thoigian()
Dim lastRow As Long, r As Long, k As Long, Q8 As Long, data(), ketqua(), rng As Range, dic As Object
    Set rng = ThisWorkbook.Worksheets("Gio nghiem thu").Range("A2:G26")
    With ThisWorkbook.Worksheets("Danh muc NT cong viec")
        lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
        If lastRow < 8 Then Exit Sub
        data = .Range("E8:Q" & lastRow).Value
    End With
    ReDim ketqua(1 To UBound(data), 1 To 5)
    Set dic = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(data, 1)
        Q8 = data(r, 13)
'        dem Q8
        If dic.exists(Q8) Then
            dic.Item(Q8) = dic.Item(Q8) + 1
        Else
            dic.Add Q8, 1
        End If
'        cot H
        If Not IsEmpty(data(r, 5)) Then ketqua(r, 5) = data(r, 1)
'        cot N va O
        ketqua(r, 2) = data(r, 8)    ' cot N
        ketqua(r, 3) = data(r, 8)    ' cot O
'        cot M va P
        If data(r, 1) = "" Or Q8 = 0 Then
            ketqua(r, 1) = "" ' cot M
            ketqua(r, 4) = ""    ' cot P
        Else
            k = ((dic.Item(Q8) - 1) Mod 3) + 1
            ketqua(r, 1) = Application.VLookup(Q8, rng, 2 * k, 0)    ' cot M
            ketqua(r, 4) = Application.VLookup(Q8, rng, 2 * k + 1, 0)   ' cot P
        End If
    Next r
'    nhap ket qua vao sheet
    With ThisWorkbook.Worksheets("Danh muc NT cong viec")
        .Range("H8").Resize(UBound(data)).Value = Application.Index(ketqua, 0, 5)
        .Range("M8").Resize(UBound(data), 4).Value = ketqua
    End With
    Set dic = Nothing
End Sub

 

[Phamvannhan1531]

Bạn tự kiểm tra

Sub doituong_thoigian()
Dim lastRow As Long, r As Long, k As Long, Q8 As Long, data(), ketqua(), rng As Range, dic As Object
    Set rng = ThisWorkbook.Worksheets("Gio nghiem thu").Range("A2:G26")
    With ThisWorkbook.Worksheets("Danh muc NT cong viec")
        lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
        If lastRow < 8 Then Exit Sub
        data = .Range("E8:Q" & lastRow).Value
    End With
    ReDim ketqua(1 To UBound(data), 1 To 5)
    Set dic = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(data, 1)
        Q8 = data(r, 13)
'        dem Q8
        If dic.exists(Q8) Then
            dic.Item(Q8) = dic.Item(Q8) + 1
        Else
            dic.Add Q8, 1
        End If
'        cot H
        If Not IsEmpty(data(r, 5)) Then ketqua(r, 5) = data(r, 1)
'        cot N va O
        ketqua(r, 2) = data(r, 8)    ' cot N
        ketqua(r, 3) = data(r, 8)    ' cot O
'        cot M va P
        If data(r, 1) = "" Or Q8 = 0 Then
            ketqua(r, 1) = "" ' cot M
            ketqua(r, 4) = ""    ' cot P
        Else
            k = ((dic.Item(Q8) - 1) Mod 3) + 1
            ketqua(r, 1) = Application.VLookup(Q8, rng, 2 * k, 0)    ' cot M
            ketqua(r, 4) = Application.VLookup(Q8, rng, 2 * k + 1, 0)   ' cot P
        End If
    Next r
'    nhap ket qua vao sheet
    With ThisWorkbook.Worksheets("Danh muc NT cong viec")
        .Range("H8").Resize(UBound(data)).Value = Application.Index(ketqua, 0, 5)
        .Range("M8").Resize(UBound(data), 4).Value = ketqua
    End With
    Set dic = Nothing
End Sub

em có áp dụng đoạn code của bác hôm qua nhưng báo lỗi. nhờ các anh chi xem giúp ạ

Sub dlnk()​
Range("T7:T307") = "=IF(AND(NhatKy!R2C29>=RC[-14],NhatKy!R2C29<=RC[-12]),""x"","")"​
Range("T7:T307").Value = Range("T7:T307").Value​
End Sub​

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

Lại "Quá đơn giản" roài

Sub dlnk()
Range("T7:T307") = "=IF(AND(NhatKy!R2C29>=RC[-14],NhatKy!R2C29<=RC[-12]),""x"","")"
Range("T7:T307").Value = Range("T7:T307").Value
End Sub

bác xem giúp em sai ở đâu mà báo lỗi với ạ

 

[batman1]

em có áp dụng đoạn code của bác hôm qua nhưng báo lỗi. nhờ các anh chi xem giúp ạ

Sub dlnk()​
Range("T7:T307") = "=IF(AND(NhatKy!R2C29>=RC[-14],NhatKy!R2C29<=RC[-12]),""x"","")"​
Range("T7:T307").Value = Range("T7:T307").Value​
End Sub​

Hãy viết rõ. Bạn chạy code của tôi thấy có lỗi? Nếu thế thì chỉ ra lỗi ở chỗ nào.

Đừng có viết 1 câu chung chung rồi đính kèm code gì đó. Tôi có viết code sub dlnk đâu? Chuyện nào rõ ràng ra chuyện đó nhé.

Mà trong tập tin mà tôi giúp thì làm quái gì có sheet NhatKy. Rõ ràng là tập tin khác. Vậy thì đừng viết: em có áp dụng đoạn code của bác hôm qua nhưng báo lỗi.

 

[Phamvannhan1531]

Hãy viết rõ. Bạn chạy code của tôi thấy có lỗi? Nếu thế thì chỉ ra lỗi ở chỗ nào.

Đừng có viết 1 câu chung chung rồi đính kèm code gì đó. Tôi có viết code sub dlnk đâu? Chuyện nào rõ ràng ra chuyện đó nhé.

Mà trong tập tin mà tôi giúp thì làm quái gì có sheet NhatKy. Rõ ràng là tập tin khác. Vậy thì đừng viết: em có áp dụng đoạn code của bác hôm qua nhưng báo lỗi.

dạ em hiểu ạ. Em xin rút kinh nghiệm lần sau ạ