Nhờ giúp đỡ ( Code điền công thức) (1 người xem)

[levanhoa1977]

ACE giúp điền code sheet IN. Cột A trống thì ko điền gì hết. Có có MSP thì điền công thức.
Cảm ơn.

 

[giaiphap]

ACE giúp điền code sheet IN. Cột A trống thì ko điền gì hết. Có có MSP thì điền công thức.
Cảm ơn.

Mà điền công thức cho ô nào, dòng nào và cột nào vậy bạn?

 

[levanhoa1977]

Mà điền công thức cho ô nào, dòng nào và cột nào vậy bạn?

Diền từ F6:AK nhưng nó kiểm tra cột A trống thì không điền gì hết và được tô mau vàng.

 

[levanhoa1977]

Sửa lại dòng code trong file của bạn như vầy.

Sheet6.Range("F6:AK" & DongCuoi).FormulaR1C1 = _
"=IF(RC1<>"""",SUMPRODUCT(--('DATA'!R3C2:R" & Kds & "C2=RC1)*('DATA'!R3C4:R" & Kds & "C4=R3C)*('DATA'!R3C22:R" & Kds & "C22=R3C1),('DATA'!R3C12:R" & Kds & "C12)),"""")"

Cái này ko đúng ý đồ bạn ơi. Của bạn là lồng thêm hảm if nếu giá trị cột a trống thì ko điền ko thức. Mình muốn công thức những dòng tô vàng để trống để mình điền công thức tay vào. Khi đó nó sẽ ko mất giá trị. Những cũng cảm ơn bạn góp ý.

 

[levanhoa1977]

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim DongCuoi As Long, Kds As Long
Dim Rng As Range
Kds = Sheet5.[D65000].End(xlUp).Row
DongCuoi = Sheet6.[A65000].End(xlUp).Row
Range("A5", Range("A65000").End(3)).Resize(, 40).AutoFilter 1, "<>"
Range("A5", Range("A65000").End(3)).Offset(, 5).Resize(, 32).SpecialCells(xlCellTypeVisible).Value = _
"=IF(RC1<>"""",SUMPRODUCT(--('DATA'!R3C2:R" & Kds & "C2=RC1)*('DATA'!R3C4:R" & Kds & "C4=R3C)*('DATA'!R3C22:R" & Kds & "C22=R3C1),('DATA'!R3C12:R" & Kds & "C12)),"""")"
Sheet6.Range("F6:AK" & DongCuoi).Value = Sheet6.Range("F6:AK" & DongCuoi).Value
Sheet6.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Cảm ơn bạn nhiều nhiều.

 

[levanhoa1977]

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim DongCuoi As Long, Kds As Long
Dim Rng As Range
Kds = Sheet5.[D65000].End(xlUp).Row
DongCuoi = Sheet6.[A65000].End(xlUp).Row
Range("A5", Range("A65000").End(3)).Resize(, 40).AutoFilter 1, "<>"
Range("A5", Range("A65000").End(3)).Offset(, 5).Resize(, 32).SpecialCells(xlCellTypeVisible).Value = _
"=IF(RC1<>"""",SUMPRODUCT(--('DATA'!R3C2:R" & Kds & "C2=RC1)*('DATA'!R3C4:R" & Kds & "C4=R3C)*('DATA'!R3C22:R" & Kds & "C22=R3C1),('DATA'!R3C12:R" & Kds & "C12)),"""")"
Sheet6.Range("F6:AK" & DongCuoi).Value = Sheet6.Range("F6:AK" & DongCuoi).Value
Sheet6.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Test lại vẫn bị lỗi bạn ởi. Khi điền công thức hay giá trị vào mấy dòng vàng thì nó cũng tự điền giá trị sang 1 số ô khác.

 

[levanhoa1977]

Flter gián giá trị nó bị lỗi thì phải. Cái này mình muốn gián giá trị nhưng ô điền công thức thôi. Nhưng ô màu vàng thì thì giữ nguyên. Ko làm gì hết.

 

[Ba Tê]

Flter gián giá trị nó bị lỗi thì phải. Cái này mình muốn gián giá trị nhưng ô điền công thức thôi. Nhưng ô màu vàng thì thì giữ nguyên. Ko làm gì hết.

Điền công thức, xong rồi lại gán thành giá trị.
Sao không lấy luôn giá trị không cần công thức?
Chạy thử Sub này có xài được không.

Public Sub GPE_1()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Tem As String, D As Date
Set Dic = CreateObject("scripting.Dictionary")
sArr = Sheets("DATA").Range("A3", Sheets("DATA").Range("A3").End(xlDown)).Resize(, 22).Value
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 2) & "#" & sArr(I, 4) & "#" & sArr(I, 22)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 12)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 12)
    End If
Next I
With Sheets("IN")
    D = .Range("A3").Value
    R = .Range("A65536").End(xlUp).Row
    sArr = .Range("A6:A" & R).Value
    tArr = .Range("F3:AK3").Value
    dArr = .Range("F6:AK" & R).FormulaR1C1
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then
            For J = 1 To UBound(tArr, 2)
                Tem = sArr(I, 1) & "#" & tArr(1, J) & "#" & D
                If Dic.Exists(Tem) Then dArr(I, J) = Dic.Item(Tem)
            Next J
        End If
    Next I
    .Range("F6:AK" & R) = dArr
End With
Set Dic = Nothing
End Sub

 

[levanhoa1977]

Nếu sheet Data bớt một sản phảm nào đi thì giá trị củ vẫn giữ nguyên. Ko cập nhật được hết. Hay ta đự đánh tay vào ô nào đó sheet in. Khi đó nó lấy dữ liệu qua ko xóa đi đữ liệu củ rồi cập nhật dữ liệu mới.

 

[levanhoa1977]

Code trên chạy lấy luôn giá trị cũng được. Nhưng Khi xóa dữ liệu hết một sản phẩm nào đó thì bên sheet in không cập nhật lại giá trị đó .Nên kết quả sai. Hay mình lỡ tay gõ vào ô nào đó mà bên sheet in mà bên sheet Data ko có sản phẩm đó thì số lượng phải được cập nhật lại mới đúng.

 

[levanhoa1977]

Nếu sheet in được điền tay vào khu vực màu đỏ. Hay dữ liệu cũ còn khi ta thây đổi dữ liệu sheet data. Thì mấy số lượng đó vẫn còn. Như vậy kết quả chưa đúng. Nếu ta xóa hết kết quả sheet IN chạy lại thì kết quả đúng.

 

[Ba Tê]

Nếu sheet in được điền tay vào khu vực màu đỏ. Hay dữ liệu cũ còn khi ta thây đổi dữ liệu sheet data. Thì mấy số lượng đó vẫn còn. Như vậy kết quả chưa đúng. Nếu ta xóa hết kết quả sheet IN chạy lại thì kết quả đúng.

1/ Vùng màu đỏ có cả dòng 5, không đúng yêu cầu ban đầu (cột A trống thì giữ nguyên)
Nó có "con khỉ" gì đó thì để nguyên "con khỉ".

2/ Tìm trong Sub cũ, thêm vào chỗ này:

For J = 1 To UBound(tArr, 2)
                dArr(I, J) = Empty               '<---------Thêm dòng này'
                Tem = sArr(I, 1) & "#" & tArr(1, J) & "#" & D
                If Dic.Exists(Tem) Then dArr(I, J) = Dic.Item(Tem)
Next J