Tìm dữ liệu tại cột B tương ứng với “So mon:” tại cột A trong vùng (vùng có độ rộng thay đổi)
Em xin gửi lời cảm ơn trước tới các bác đã giúp đỡ rất nhiều trong thời gian qua.
Em có đính kèm file. Mong muốn sẽ tìm được giá trị tại cột A của Sheet VoSo tương ứng với row của So mon: ở cột B và trả dữ liệu về Sheet Data Voso
Em có sử dụng công thức excel nhưng nếu số lượng page bị trống So mon: càng nhiều thì hàm sẽ càng lặp lại nhiều rất dễ sai, khi lỗi không biết sửa ở đâu và chạy với số lượng lớn thì rất chậm.
Khi page chứa giá trị So mon: trong vùng thì trả về giá trị tại cột B
Khi page trống So mon: thì page đầu tiên sẽ trả về giá trị 33, các page sau sẽ trả về giá trị 38. Page cuối cùng gần nhất chứa So mon: sẽ trả về giá trị tại cột B trừ đi giá trị các ô đã gán giá trị trước đó.
Sau khi kết thúc page có So mon: thì sang page tiếp theo sẽ tính lại từ đầu.
Mong muốn có VBA để tăng được tốc độ xử lý và bao quát hơn vì dữ liệu lớn thì số cột sẽ phát sinh sai sót.
Một lần nữa, em xin cảm ơn các bác rất nhiều.
Bạn thử với con rùa này của mình:
Sub TimChiSoDong()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Arr(), MyAdd As String
Dim Rws As Long, W As Integer
Set Sh = ThisWorkbook.Worksheets("VoSo")
Sheets("Data").Select
Rws = Sh.Cells(9999, "A").End(xlUp).Row
.Resize(Rws, 3).ClearContents
Set Rng = Sh..Resize(Rws)
Set sRng = Rng.Find(" Page ", , xlFormulas, xlPart)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
With Cells(Rws, "A").End(xlUp)
.Offset(1).Value = sRng.Value
.Offset(1, 1).Value = sRng.Row
End With
W = W + 1
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Cells(Rws, "B").End(xlUp).Offset(1) = Rws
For Each Cls In Range(, .End(xlDown).Offset(-1))
Set Rng = Sh.Range(Sh.Cells(Cls.Value, "A"), Sh.Cells(Cls.Offset(1).Value, "A"))
For Each sRng In Rng
If sRng.Value = "So mon:" Then
Cls.Offset(, 1).Value = sRng.Offset(, 1).Value
Cls.Offset(, 2).Value = sRng.Row
End If
Next sRng
Next Cls
End Sub
Chú í: Tên trang tính!
www.giaiphapexcel.com/diendan/threads/t%C3%ACm-d%E1%BB%AF-li%E1%BB%87u-t%E1%BA%A1i-c%E1%BB%99t-b-t%C6%B0%C6%A1ng-%E1%BB%A9ng-v%E1%BB%9Bi-so-mon-t%E1%BA%A1i-c%E1%BB%99t-a-trong-v%C3%B9ng-v%C3%B9ng-c%C3%B3-%C4%91%E1%BB%99-r%E1%BB%99ng-thay-%C4%91%E1%BB%95i.165116/
Khóa học Power PI – Ứng dung trong Nhân sự
TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...
Xem khóa học
Dùng thử code này xem sao
Sub Test()
Dim lr&, i&, j&, k&, t&, max&, sodong&, valu, rng
Dim res1(), res2(), somon()
Sheets("Data VoSo").Range("A2:B10000,E2:E10000").ClearContents
With Sheets("VoSo")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
rng = .Range("A2:B" & lr).Value
sodong = WorksheetFunction.CountIf(.Range("B2:B" & lr), "*Page*")
ReDim res1(1 To sodong, 1 To 2): ReDim res2(1 To sodong, 1 To 1)
sodong = WorksheetFunction.CountIf(.Range("A2:A" & lr), "So mon:")
ReDim somon(1 To sodong, 1 To 100)
For i = 1 To UBound(rng)
If rng(i, 2) Like "*Page*" Then
j = j + 1: res1(j, 1) = rng(i, 2): res1(j, 2) = i + 1
End If
Next
For i = 1 To UBound(rng)
If rng(i, 1) = "So mon:" Then
k = k + 1: somon(k, 1) = rng(i, 2): somon(k, 2) = i + 1
End If
Next
Sheets("Data VoSo").Range("A2").Resize(UBound(res1), 2).Value = res1
For i = 1 To UBound(somon)
valu = somon(i, 1): k = 2
For j = 1 To UBound(res1)
If res1(j, 2) < somon(i, 2) Then
k = k + 1
somon(i, k) = IIf(valu < 33, valu, IIf(valu <= 38, valu, 38))
If k = 3 And somon(i, 1) > 33 Then somon(i, 3) = 33
valu = valu – somon(i, k)
res1(j, 2) = lr + 1
If k > max Then max = k
t = t + 1: res2(t, 1) = somon(i, k)
End If
Next
Next
End With
With Sheets("Data VoSo")
.Range("E2").Resize(UBound(res2), 1).Value = res2
End With
End Sub