Em có file excel muốn nội dung di chuyển có điều kiện ( mô tả có trong file đính kèm) nhờ các bác viết giúp em!

[hiv174]

file cần giúp đỡ là file (dichuyen), bác thanhmai103309 có giúp e viết code ( book1) nhưng quá trình có phát sinh lỗi là số di chuyển + số còn lại đang lớn hơn số đã cho ah. e cảm ơn!

 

[snow25]

file cần giúp đỡ là file (dichuyen), bác thanhmai103309 có giúp e viết code ( book1) nhưng quá trình có phát sinh lỗi là số di chuyển + số còn lại đang lớn hơn số đã cho ah. e cảm ơn!

Thử code.

Sub abc()
    Dim i As Long, lr As Long, dic As Object, arr, kq, a As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("G" & Rows.Count).End(xlUp).Row
        arr = .Range("G2:H" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:C" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If dic.exists(dk) Then
                a = a + 1
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
            End If
       Next i
       lr = .Range("K" & Rows.Count).End(xlUp).Row
       If a > 1 Then .Range("K2:M" & lr).ClearContents
       If a Then .Range("K2:m2").Resize(a).Value = kq
  End With
  Set dic = Nothing
End Sub

 

[hiv174]

Thử code.

Sub abc()
    Dim i As Long, lr As Long, dic As Object, arr, kq, a As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("G" & Rows.Count).End(xlUp).Row
        arr = .Range("G2:H" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:C" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If dic.exists(dk) Then
                a = a + 1
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
            End If
       Next i
       lr = .Range("K" & Rows.Count).End(xlUp).Row
       If a > 1 Then .Range("K2:M" & lr).ClearContents
       If a Then .Range("K2:m2").Resize(a).Value = kq
  End With
  Set dic = Nothing
End Sub

em cảm ơn, file chạy được rồi ah