Как написать два оператора IF для разных диапазонов в цикле, VBA - PullRequest
0 голосов
/ 16 января 2019

Я работаю над документом Excel, используя VBA. Этот документ содержит базу данных с несколькими столбцами, но для простоты, скажем, у меня есть 2 столбца:

  • Столбец C соответствует именам
  • Столбец F соответствует числам.

Я пытаюсь создать макрос, который проверяет все числа в столбце F (с помощью цикла). Если число превышает 100, то проверьте соседнюю ячейку в столбце C. Если имя соответствует условию (скажем, соответствует Джону или Тому), добавьте значение числа на другом листе. Если ни один из них не подходит, проверьте следующую ячейку.

Моя проблема в том, что я не могу найти способ определения ячеек в столбце C (создание переменной / объекта для вызова ячеек или прямой вызов соседней ячейки).

Мой код выглядит так:

Sub Test1()

    Dim rngnumbers, rngnames, MultipleRange As Range

    Set rngnumbers = Sheet2.Range("F2:F999")    
    Set rngnames = Sheet2.Range("C2:C999")
    Set MultipleRange = Union(rngnumbers, rngnames)

        For Each numb In rngnumbers
            If numb.Value >= 100 Then
                    If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
                        Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
                    Else
                    End If
            End If
        Next numb

End Sub

Я попытался изменить строку:

'If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Тогда ' что-то вроде: 'newname.String = "John" '

Но я не могу найти способ определить newname. Другая идея заключается в увеличении оператора If для имен в цикле For.

Дополнительные примечания: Я также не использую формулы непосредственно в Excel, так как не хочу пустых ячеек или нулей, если функции if имеют значение False.

Ответы [ 4 ]

0 голосов
/ 16 января 2019

Я обычно работаю с массивами:

Sub Test1()

Dim rngnumbers    As Excel.Range

Dim arrVals       As variant 

Dim lngRow        As long

Arrvals = Sheet2.Range("C2:F999").value

    For Lngrow = lbound(arrvals,1) to ubound(arrvals,1)
        If arrvals(lngrow,4) >= 100 Then
                If arrvals(lngrow,1)= "John" Or arrvals(lngrow,1) = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
                    Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = arrvals(lngrow,4)
                Else
                End If
        End If
    Next lngrow 

End Sub

На самом деле, я бы тоже, вероятно, построил выходной массив, но мой большой палец устал ...

0 голосов
/ 16 января 2019

Вы хотите что-то подобное?

Sub Test1()

        Dim lRow As Long, r As Long
        lRow = 1000 'last row in your data
        Dim ws As Worksheet
        Set ws = Worksheets("List with your data")

        For i = 2 To lRow
            If ws.Range("F" & i) > 100 Then
                If ws.Range("C" & i).Value = "John" Or ws.Range("C" & i).Value = "Tom" Then
                    Worksheets("Another sheet sheet").Range("A" & r) = Range("C" & i).Value ' r - Row, where we want to enter uor text
                    r = r + 1 'if you want to put next name on the next row
                End If
            End If
        Next

    End Sub
0 голосов
/ 16 января 2019

Два If в цикле

Версия Union

Option Explicit

Sub Test1()

    Const cFirst As Integer = 2
    Const cLast As Integer = 999
    Const cCol1 As Variant = "F"
    Const cCol2 As Variant = "C"
    Const cCol3 As Variant = "I"

    Dim i As Integer
    Dim rngU As Range

    With Sheet2
        For i = cFirst To cLast
            If IsNumeric(.Cells(i, cCol1)) And .Cells(i, cCol1) >= 100 Then
                If .Cells(i, cCol2) = "John" _
                        Or .Cells(i, cCol2) = "Tom" Then
                    If Not rngU Is Nothing Then
                        Set rngU = Union(rngU, .Cells(i, cCol1))
                      Else
                        Set rngU = .Cells(i, cCol1)
                    End If
                End If
            End If
        Next
    End With

    If Not rngU Is Nothing Then
        rngU.Copy Sheet1.Cells(cLast, cCol3).End(xlUp).Offset(1, 0)
        Set rngU = Nothing
    End If

End Sub
0 голосов
/ 16 января 2019

Решает ли это вашу проблему - ссылки на соответствующую ячейку в столбце C? OFFSET обеспечивает относительную ссылку, в этом случае посмотрите 3 столбца слева от F.

Sub Test1()

Dim rngnumbers As Range, rngnames As Range, MultipleRange As Range, numb As Range

Set rngnumbers = Sheet2.Range("F2:F999")
Set rngnames = Sheet2.Range("C2:C999")
Set MultipleRange = Union(rngnumbers, rngnames)

For Each numb In rngnumbers
    If numb.Value >= 100 Then
        If numb.Offset(, -3) = "John" Or numb.Offset(, -3) = "Tom" Then
            Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
        End If
    End If
Next numb

End Sub

Вы рассматривали SUMIFS вместо этого?

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