Lập trình cập nhật giá từ 1 sheet khác (1 người xem)

[lamchanphieu]

VÌ BẢNG GIÁ CÓ TỚI 20000 DÒNG, ĐẺ TiỆN CHO ViỆC THAY ĐỔI GIÁ BÁN, NÊN MÌNH CẦN CODE CẬP NHẬT GIÁ 1, GIÁ 2 VÀ GIÁ 3,ĐỐI VỚI NHỮNG MÃ HÀNG GiỐNG NHAU TỪ SHEET 1 SANG SHEET 2 ,CÒN NHỮNG MÃ HÀNG SHEET 1 KHÔNG CÓ THÌ GiỮ NGUYÊN
XIN CÁC THẦY CÔ,CÁC BẠN VUI LÒNG GIÚP ĐỠ!

 

[Ba Tê]

VÌ BẢNG GIÁ CÓ TỚI 20000 DÒNG, ĐẺ TiỆN CHO ViỆC THAY ĐỔI GIÁ BÁN, NÊN MÌNH CẦN CODE CẬP NHẬT GIÁ 1, GIÁ 2 VÀ GIÁ 3,ĐỐI VỚI NHỮNG MÃ HÀNG GiỐNG NHAU TỪ SHEET 1 SANG SHEET 2 ,CÒN NHỮNG MÃ HÀNG SHEET 1 KHÔNG CÓ THÌ GiỮ NGUYÊN
XIN CÁC THẦY CÔ,CÁC BẠN VUI LÒNG GIÚP ĐỠ!

Bạn chạy thử Sub này, kiểm tra kết quả nếu đúng thì thay địa chỉ trong Sub để gán vào cột bạn muốn.

Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
    sArr = .Range("A5", .Range("A5").End(xlDown)).Resize(, 5).Value
End With
ReDim tArr(1 To UBound(sArr), 1 To 3)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        For J = 1 To 3
            tArr(K, J) = sArr(I, J + 2)
        Next J
    End If
Next I
With Sheets("Sheet2")
    sArr = .Range("A13", .Range("A13").End(xlDown)).Resize(, 8).Value
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For I = 1 To UBound(sArr)
        Tem = sArr(I, 1)
        For J = 1 To 3
            If Dic.Exists(Tem) Then
                K = Dic.Item(Tem)
                dArr(I, J) = tArr(K, J)
            Else
                dArr(I, J) = sArr(I, J + 5)
            End If
        Next J
    Next I
    .Range("L13").Resize(I - 1, 3) = dArr   '<----Thay chỗ này thành ("F13")-->'
End With
Set Dic = Nothing
MsgBox "XONG!", , "GPE"
End Sub

 

[lamchanphieu]

Hay quá, đúng rồi bạn ơi, mình xin cảm ơn nhiều nhé!