Em có bài toán muốn nhờ trợ giúp của các bác, bài toán của em là em muốn update giá trị (các cột min 4a, max 4a., min 6a, max6a)từ bảng 2 sang bảng 1, đoạn code em viết ở dưới thì dùng được rồi ạ, nhưng có điều là khi update giá trị vào thì nó được hiểu như là tìm kiếm ví dụ cột min 6a, max 6a và copy (min 6a, max 6a...) cột đó từ bảng 2 sang bảng 1, giờ em muốn nó copy nhưng đọc theo tên lỗ khoan (LKVU-BS1,LKVU-BS2.....) như chữ bôi đỏ bảng 1(e ví dụ tên lỗ khoan ở bảng 1 xếp lộn xộn chỗ bôi đỏ ạ,). Nhờ các bác giúp e với nhé. Em xin chân thành cảm ơn các bác. file và hình ảnh e có đính kèm ở dưới ạ.
Mã:
Sub UpdateRQD()
Dim iRow As Long, iCol As Long, r As Long, c As Long, data(), result(), dic As Object, sh As Worksheet, wb As Workbook
data = Range("A17:L22").Value
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbTextCompare
For c = 1 To UBound(data, 2)
If Not dic.exists(data(1, c)) And data(1, c) <> 0 Then dic.Add data(1, c), c
Next c
result = Range("A3:R8").Value
For c = 1 To UBound(result, 2)
' neu tieu de co trong mang data thi thuc hien
If dic.exists(result(1, c)) Then
' doc tu dic ra chi so cot trong mang data cua tieu de hien hanh
iCol = dic.Item(result(1, c))
' copy cot curr_col cua mang data sang cot c cua mang result
For r = 2 To UBound(result)
result(r, c) = data(r, iCol)
Next r
End If
Next c
Range("A3").Resize(UBound(result), UBound(result, 2)).Value = result
Set dic = Nothing
End Sub