Cảm ơn Bro. Mình quên mất k xóa cái đó. Nhưng xóa xong bản chat vẫn không đúng như mình mong muốn.
Nó lại tham chiếu tất cả giá trị cột E sheet1 kể cả các hàng đã có dữ lieu.... mình muốn hàng nào ở cột E sheet1 có dữ lieu rồi thì nó bỏ qua không tham chiếu.
Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long, ma As String
Dim lastRow As Long, lastRowE As Long
With Sheet1
lastRowE = .Range("E" & Rows.Count).End(xlUp).Row
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
If lastRow <= lastRowE Then Exit Sub
arr1 = .Range("A" & lastRowE + 1).Resize(lastRow - lastRowE, 5).Value
End With
With Sheet2
lastRow = .Range("D" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then Exit Sub
arr = .Range("D2:H" & lastRow).Value
End With
For i = 1 To UBound(arr1, 1)
ma = UCase(arr1(i, 1))
For j = 1 To UBound(arr, 1)
If ma = UCase(arr(j, 1)) Then
arr1(i, 5) = arr(j, 5)
Exit For
End If
Next j
Next i
Sheet1.Range("A" & lastRowE + 1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
MsgBox "Completed"
End Sub
Có thể dùng Dictionary thay cho vòng lặp For j = ...
Sub Button1_Click()
Dim arr, arr1
Dim i, a As Long, j As Long, ma As String
Dim lastRow As Long, lastRowE As Long
With Sheet1
lastRowE = .Range("E" & Rows.Count).End(xlUp).Row
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
If lastRow <= lastRowE Then Exit Sub
arr1 = .Range("A" & lastRowE + 1).Resize(lastRow - lastRowE, 5).Value
End With
With Sheet2
lastRow = .Range("D" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then Exit Sub
arr = .Range("D2:H" & lastRow).Value
End With
For i = 1 To UBound(arr1, 1)
ma = UCase(arr1(i, 1))
For j = 1 To UBound(arr, 1)
If ma = UCase(arr(j, 1)) Then
arr1(i, 5) = arr(j, 5)
Exit For
End If
Next j
Next i
Sheet1.Range("A" & lastRowE + 1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
MsgBox "Completed"
End Sub
Có thể dùng Dictionary thay cho vòng lặp For j = ...
Em muốn hỏi anh thêm 1 đoạn code ạ. Trong file đính kèm em muốn copy dữ lieu từ sheet2 sang sheet1...vì sheet1 số dòng không cố định nên nó sẽ tìm và copy vào dòng trống đầu tiên của mỗi trường dữ lieu. Em có bôi vàng trong file ạ. Sheet2 các cột sắp xếp lung tung k theo định dạng như sheet1.
Em có dung code copy như dưới nhưng khá là chậm và có vẻ không được tốt.
Anh vui long kiểm tra và cho em 1 cách khác để thực hiên việc này với nhé.
Em xin cảm ơn ạ!
Dim a As Long, b As Long
'' Ma So
Sheet2.Range("D2", Range("D" & Rows.Count).End(xlUp)).Copy
Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sub Button1_Click()
Dim lastRow As Long, start As Long
lastRow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then Exit Sub
start = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
' Ma So
Sheet2.Range("D2:D" & lastRow).Copy Sheet1.Range("A" & start)
' Ten
Sheet2.Range("F2:F" & lastRow).Copy Sheet1.Range("B" & start)
' Date
Sheet2.Range("E2:E" & lastRow).Copy Sheet1.Range("C" & start)
' DVT , SL
Sheet2.Range("G2:H" & lastRow).Copy Sheet1.Range("D" & start)
End Sub
