Option Explicit

Function ReadTXTfile(ByVal filename As String) As String
    Dim fso As Object
    Dim ts As Variant
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing
End Function

Sub ReadTXT()
    Dim AllText() As String
    Dim Values() As String
    Dim buff() As String
    Dim i As Long
    Dim j As Integer
    Dim lLastRow As Long
    Dim Top As String
    Dim Bottom As String
    Dim InsideInterval As Boolean
    
    AllText = Split(ReadTXTfile(Application.ThisWorkbook.Path & "/1.txt"), vbNewLine)
    ReDim Values(1 To UBound(AllText), 1 To 5)
    
    For i = 1 To UBound(AllText)
        If AllText(i) <> "" Then
        buff = Split(AllText(i), " ")
            For j = 0 To UBound(buff)
                Values(i, j + 1) = buff(j)
            Next j
        End If
    Next i
    InsideInterval = False
    For i = 1 To UBound(Values, 1)
        With Worksheets("Sheet1")
            'Debug.Print (Values(i, 1) & " " & Values(i, 2) & " " & Values(i, 3))
            If InsideInterval = False And Values(i, 2) < Values(i, 5) Then
                InsideInterval = True
                lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
                Top = Values(i, 1)
                .Cells(lLastRow + 1, 1) = Top
            End If
                If InsideInterval = True And Values(i, 2) > Values(i, 5) Then
                InsideInterval = False
                lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
                Bottom = Values(i - 1, 1)
                .Cells(lLastRow + 1, 2) = Bottom
            End If
        End With
    Next
End Sub

Sub Paint()

    Dim lRow As Long
    Dim i As Long
    Dim ws As Worksheet
        
    'переменные для хранения граничных значений
    Dim brdBottom As Integer
    Dim brdMiddle As Integer
    Dim brdTop As Integer
    
    'переменные для хранения цветовых заливок
    Dim clrGreen, clrYellow, clrOrange, clrRed
        
    clrGreen = RGB(144, 238, 144)
    clrYellow = RGB(255, 255, 0)
    clrOrange = RGB(255, 165, 0)
    clrRed = RGB(255, 0, 0)
    
    With Worksheets("Settings")
        'Получение текущих граничных значений
        brdBottom = .Cells(1, 1).Value
        brdMiddle = .Cells(2, 1).Value
        brdTop = .Cells(3, 1).Value
    End With
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "WS*" Then
            With ws
            lRow = .Cells(Rows.Count, 1).End(xlUp).Row
                       
            For i = 1 To lRow
            
            .Cells(i, 4).Value = .Cells(i, 2).Value - .Cells(i, 1).Value
            If .Cells(i, 4).Value >= 0 Then
                .Cells(i, 4).Interior.Color = vbGreen
            Else
                .Cells(i, 4).Interior.Color = vbRed
            End If
            
                If IsNumeric(.Cells(i, 3).Value) = True Then
                        Select Case .Cells(i, 3).Value
                        Case Is <= brdBottom
                            .Cells(i, 3).Interior.Color = clrGreen
                        Case brdBottom To brdMiddle
                            .Cells(i, 3).Interior.Color = clrYellow
                        Case brdMiddle To brdTop
                            .Cells(i, 3).Interior.Color = clrOrange
                        Case Is > brdTop
                            .Cells(i, 3).Interior.Color = clrRed
                        End Select
                End If
            Next i
            End With
        End If
    Next
    
End Sub

Option Explicit

Sub main()

Dim x1: Dim x2: Dim x3: Dim x4: Dim x5: Dim x6
Dim a: Dim b: Dim c: Dim d: Dim e: Dim f: Dim i: Dim lLastRow

i = 1
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
    For a = 2 To lLastRow
    x1 = Worksheets("Sheet1").Cells(a, 1).Value
        For b = 2 To lLastRow
        x2 = Worksheets("Sheet1").Cells(b, 2).Value
            For c = 2 To lLastRow
            x3 = Worksheets("Sheet1").Cells(c, 3).Value
                For d = 2 To lLastRow
                x4 = Worksheets("Sheet1").Cells(d, 4).Value
                    For e = 2 To lLastRow
                    x5 = Worksheets("Sheet1").Cells(e, 5).Value
                        For f = 2 To lLastRow
                        x6 = Worksheets("Sheet1").Cells(f, 6).Value
                            If x1 * x2 * x3 * x4 * x5 * x6 = 9000 Then
                                i = i + 1
                                Worksheets("Sheet1").Cells(i, 9).Value = x1
                                Worksheets("Sheet1").Cells(i, 10).Value = x2
                                Worksheets("Sheet1").Cells(i, 11).Value = x3
                                Worksheets("Sheet1").Cells(i, 12).Value = x4
                                Worksheets("Sheet1").Cells(i, 13).Value = x5
                                Worksheets("Sheet1").Cells(i, 14).Value = x6
                            End If
                         Next
                    Next
                Next
            Next
        Next
    Next
Application.ScreenUpdating = True
End Sub

Option Explicit

Public n As Integer
Public lLenght As Integer

Sub Calc()
Dim Source As Double
'Длина диапазона для отображения на графике-осцилограмме
lLenght = 60
    'Выполнение по времени
    Application.OnTime Now + 0.000006, "Calc"
    'Заполняем ячейку случайным числом, имитируя работу сторонней программы
    Randomize
    Worksheets("Sheet1").Cells(1, 3).Value = Rnd(1)
    'и считываем значение ячейки в переменную
    Source = Worksheets("Sheet1").Cells(1, 3).Value
        'Первый запуск, заполняем ячейки с первой до lLenght
        If n < lLenght Then
            n = n + 1
            Worksheets("Sheet1").Cells(n, 1).Value = Source
        'Достигнув lLenght, первая строка при каждой итерации удаляется и запись
        'производится в последнюю ячейку, соответсвующую выбранной длине отображения
        Else
            n = lLenght
            Worksheets("Sheet1").Cells(1, 1).Delete Shift:=xlUp
            Worksheets("Sheet1").Cells(n, 1).Value = Source
        End If
    'После удаления первой ячейки, переназначаем графику диапазон для отображения
    Worksheets("Sheet1").ChartObjects("Chart 8").Chart.SetSourceData Source:=Worksheets("Sheet1").Range("A1:A" & lLenght)
    Application.ScreenUpdating = True
End Sub