Есть ли способ создать одну колонку из двух? - PullRequest
0 голосов
/ 14 мая 2019

Я пытаюсь создать новый столбец, который использует критерии из двух других столбцов для вывода.Прямо сейчас я получаю ошибку несоответствия типов.До этого мой вывод вообще не выходил.

Sub FormatcolumnF()

    Dim eqa As Range, eqt As Range, rngResult As Range
    Dim arr_a As Variant, arr_t As Variant
    Dim wks As Worksheet, i As Integer
    Dim lngLastRow As Long

    Set wks = ActiveSheet
    'or even better by name like "Worksheets(Table1)"

    With wks
        'Now that the Worksheet is defined, we'll find the last row number
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row

        'We can now use a Range to grab all the category data
        Set eqa = .Range(.Cells(2, 4), .Cells(lngLastRow, 1))
        Set eqt = .Range(.Cells(2, 3), .Cells(lngLastRow, 1))
    End With

    arr_a = eqa
    arr_t = eqt

    Dim result As String

    For i = LBound(arr_a, 1) To UBound(arr_a, 1)
                If arr_a(i, 1) >= arr_t(i, 1) - 0.025 _
                    Or arr_a(i, 1) <= arr_t(i, 1) + 0.025 Then
                    result = "ON TARGET"
                ElseIf arr_a(i, 1) <= arr_t(i, 1) - 0.025 Then
                    result = "UNDER"
                ElseIf arr_a(i, 1) >= arr_t(i, 1) + 0.025 Then
                    result = "OVER"
                End If
    Next i

    With wks
        Set rngResult = .Range(.Cells(2, 6), .Cells(lngLastRow, 1))
        .Cells(1, 6) = "OVER/UNDER"
    End With

End Sub

Мне нужен 6-й столбец на моем листе, чтобы отразить вывод строки, который основан на цикле, который я создал 3-го и 4-го столбца.У меня есть переменное количество строк.

1 Ответ

2 голосов
/ 14 мая 2019

было много мелочей, например, несоответствие столбцов в ссылках Cells в пределах диапазонов.

Но главная проблема в том, что вы ничего не делали с выводом после присвоения его переменной. Сделайте эту переменную массивом, а затем назначьте этот массив диапазону.

Также проверьте значения, чтобы убедиться, что сначала они не являются ошибками (наиболее вероятной причиной несоответствия типов) или не являются числовыми (вторая наиболее вероятная причина).

Sub FormatcolumnF()

    Dim rngResult As Range
    Dim arr_a As Variant, arr_t As Variant
    Dim wks As Worksheet, i As Long
    Dim lngLastRow As Long

    Set wks = ActiveSheet
    'or even better by name like "Worksheets(Table1)"

    With wks
        'Now that the Worksheet is defined, we'll find the last row number
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row

        'We can now use a Range to grab all the category data
        'Skip setting ranges and assign directly to the arrays
        arr_a = .Range(.Cells(2, 4), .Cells(lngLastRow, 4)) 'the 1 is column A it should match the 4
        arr_t = .Range(.Cells(2, 3), .Cells(lngLastRow, 3)) 'the 1 is column A it should match the 3

        'Create an array for the output
        Dim result() As Variant
        ReDim result(1 To UBound(arr_a, 1), 1 To 1) As Variant

        For i = LBound(arr_a, 1) To UBound(arr_a, 1)
            'make sure both arr_a and arr_t are not error and numeric
            If Not IsError(arr_a(i, 1)) And Not IsError(arr_t(i, 1)) Then
                If IsNumeric(arr_a(i, 1)) And IsNumeric(arr_t(i, 1)) Then
                    'Load the output in the array
                    ' Should be And not Or
                    If arr_a(i, 1) >= arr_t(i, 1) - 0.025 _
                        And arr_a(i, 1) <= arr_t(i, 1) + 0.025 Then
                        result(i, 1) = "ON TARGET"
                    ElseIf arr_a(i, 1) <= arr_t(i, 1) - 0.025 Then
                        result(i, 1) = "UNDER"
                    ElseIf arr_a(i, 1) >= arr_t(i, 1) + 0.025 Then
                        result(i, 1) = "OVER"
                    End If
                Else
                    result(i, 1) = "Not Numeric"
                End If
            Else
                result(i, 1) = "Error"
            End If
         Next i

        'load the output array into the cells
        .Range(.Cells(2, 6), .Cells(lngLastRow, 6)) = result
        .Cells(1, 6) = "OVER/UNDER"
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...