Lọc tên và giá trị của mẫu xét nghiệm (1 người xem)

  • Thread starter Thread starter FATA11
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

FATA11

Thành viên mới
Tham gia
29/9/22
Bài viết
11
Được thích
0
Xin chào mọi người,
Từ kết quả xét nghiệm cột B đến D

Mình muốn lọc lấy tên (w1, w3,..) và giá trị trung bình (Average) tương ứng
với điều kiện: nếu tên thí nghiệm liên tục thì viết liền nhau, không liên tục thì viết cách ô.

Kết quả mong muốn mình có nhập tay ở cột G và cột H

Mong mọi người giúp đỡ.
 

File đính kèm

Dùng đỡ củ chuối này trong khi chờ phương án khác hay hơn:
Mã:
Option Explicit
Sub thinghiem()
Dim lr&, i&, j&, k&, rng, arr(1 To 100000, 1 To 2)
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B2:D" & lr).Value
For i = 1 To UBound(rng) - 2
    If LCase(rng(i, 1)) Like "w*" Then
        k = k + 1: arr(k, 1) = rng(i, 1)
        For j = i + 1 To i + 6
            If j <= UBound(rng) Then
                If LCase(rng(j, 1)) Like "average*" Then
                    arr(k, 2) = rng(j, 3)
                    If j < UBound(rng) Then k = k + IIf(IsEmpty(rng(j + 1, 1)), 1, 0)
                    Exit For
                End If
            End If
        Next
    End If
Next
' dan ket qua vào cot G:H. Thay doi qua vung khac neu muon.
Range("G2:H10000").ClearContents
Range("G2").Resize(k, 2).Value = arr
End Sub
 

File đính kèm

Dùng đỡ củ chuối này trong khi chờ phương án khác hay hơn:
Mã:
Option Explicit
Sub thinghiem()
Dim lr&, i&, j&, k&, rng, arr(1 To 100000, 1 To 2)
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B2:D" & lr).Value
For i = 1 To UBound(rng) - 2
    If LCase(rng(i, 1)) Like "w*" Then
        k = k + 1: arr(k, 1) = rng(i, 1)
        For j = i + 1 To i + 6
            If j <= UBound(rng) Then
                If LCase(rng(j, 1)) Like "average*" Then
                    arr(k, 2) = rng(j, 3)
                    If j < UBound(rng) Then k = k + IIf(IsEmpty(rng(j + 1, 1)), 1, 0)
                    Exit For
                End If
            End If
        Next
    End If
Next
' dan ket qua vào cot G:H. Thay doi qua vung khac neu muon.
Range("G2:H10000").ClearContents
Range("G2").Resize(k, 2).Value = arr
End Sub
Em xin cảm ơn Anh
 
Web KT

Bài viết mới nhất

Back
Top Bottom