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)

Chia sẻ bởi:hands
★★★★★
Quảng cáo

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ự
Khóa học SprinGO phù hợp

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
★★★★★ 5 ★ 1 👤 1 ▥ 0
Quảng cáo

Bạn nên đọc

One Response

  1. hands says:

    Cảm ơn bác nhiều. File đã tìm được số Sheet VoSo cột B và row của ô đó. Không biết bác có thể giúp em thêm phần trừ đi cho các ô bên trên được không ạ. Em có thử sửa vào code để trừ đi nhưng báo lỗi tùm lum luôn. :((

    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

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm