Tìm giá trị trước và sau

[Minh Đức 1309]

E có A là 1 dãy số ,e muốn 1 ô tìm kiếm xem trong dãy số đó có bao nhiêu số trùng với số ô tìm kiếm và tìm ra số đứng trước và đứng sau của các dãy số đó và 1 biểu đồ chia ra tỉ lệ bao nhiêu % số đứng sau lớn hơn 10 và bao nhiêu phần trăm nhỏ hơn 11 ( e muốn làm bằng VBA ạ.Em cảm ơnn !!!!!)

 

[YourCoRoNa]

E có A là 1 dãy số ,e muốn 1 ô tìm kiếm xem trong dãy số đó có bao nhiêu số trùng với số ô tìm kiếm và tìm ra số đứng trước và đứng sau của các dãy số đó và 1 biểu đồ chia ra tỉ lệ bao nhiêu % số đứng sau lớn hơn 10 và bao nhiêu phần trăm nhỏ hơn 11 ( e muốn làm bằng VBA ạ.Em cảm ơnn !!!!!)

Bạn thử
Code trong Worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Address = "$G$1" Then
    TimsoTrongday Range("G1")
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Code trong Module

Sub TimsoTrongday(ByVal So As Long)
Dim numArray, dynamicArray, Er As Long, I As Long, K As Long, sodem As Long
    Er = Range("D" & Rows.Count).End(xlUp).Row
    Range("D1:D" & Er).Interior.Pattern = xlNone
    Range("D1:D" & Er).Font.Bold = False
    numArray = Range("D1:D" & Er).Value
    ReDim dynamicArray(1 To UBound(numArray), 1 To 4)
    For I = 1 To UBound(numArray)
        sodem = sodem + 1
        If numArray(I, 1) = So Then
        Range("D" & I).Font.Bold = True
        Range("D" & I).Interior.Color = 65535
            K = K + 1
            If sodem = 1 Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 3) = So
                dynamicArray(K, 4) = numArray(I + 1, 1)
            End If
            If sodem > 1 And sodem < UBound(numArray) Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 2) = numArray(I - 1, 1)
                dynamicArray(K, 3) = So
                dynamicArray(K, 4) = numArray(I + 1, 1)
            End If
            If sodem = UBound(numArray) Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 2) = numArray(I - 1, 1)
                dynamicArray(K, 3) = So
            End If
        End If
    Next I
    If K Then
        Range("H11").Resize(1000, 4).ClearContents
        Range("H11").Resize(K, 4) = dynamicArray
    Else
        MsgBox "Nothing"
    End If
End Sub

 

[Minh Đức 1309]

Bạn thử
Code trong Worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Address = "$G$1" Then
    TimsoTrongday Range("G1")
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Code trong Module

Sub TimsoTrongday(ByVal So As Long)
Dim numArray, dynamicArray, Er As Long, I As Long, K As Long, sodem As Long
    Er = Range("D" & Rows.Count).End(xlUp).Row
    Range("D1:D" & Er).Interior.Pattern = xlNone
    Range("D1:D" & Er).Font.Bold = False
    numArray = Range("D1:D" & Er).Value
    ReDim dynamicArray(1 To UBound(numArray), 1 To 4)
    For I = 1 To UBound(numArray)
        sodem = sodem + 1
        If numArray(I, 1) = So Then
        Range("D" & I).Font.Bold = True
        Range("D" & I).Interior.Color = 65535
            K = K + 1
            If sodem = 1 Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 3) = So
                dynamicArray(K, 4) = numArray(I + 1, 1)
            End If
            If sodem > 1 And sodem < UBound(numArray) Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 2) = numArray(I - 1, 1)
                dynamicArray(K, 3) = So
                dynamicArray(K, 4) = numArray(I + 1, 1)
            End If
            If sodem = UBound(numArray) Then
                dynamicArray(K, 1) = K
                dynamicArray(K, 2) = numArray(I - 1, 1)
                dynamicArray(K, 3) = So
            End If
        End If
    Next I
    If K Then
        Range("H11").Resize(1000, 4).ClearContents
        Range("H11").Resize(K, 4) = dynamicArray
    Else
        MsgBox "Nothing"
    End If
End Sub

E cảm ơn ạ !!!!