вернуть значение, если оно находится в пределах диапазона? - PullRequest
0 голосов
/ 27 мая 2019

в этом проекте мне нужно проверить значение столбца A между столбцом B и столбцом C. Если значения columnA> = значение Columns B или значение Columns A <= значение Columns C, то мне нужно скопировать значения столбца d и e иположить в лист1 столбец G и H. Столбец A находится в листе 1, а столбец B, C, D и E в листе 2. </p>

   A       B    C   D     E
   1       1    9   Dog   Naruto
  11      10   19   Cat   one piece
  21      20   30   Duck  lo 
  1
  31
  12
  and so on

Я хочу получить такой результат

   A    G       H
   1    Dog     Naruto   
   11   cat     One piece
   21   duck     o
   1    Dog     Naruto  
   31                   
   12   cat     One piece
   and so on

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

Dim i As Long
Dim lRow As Long
Dim colA As Double, colB As Double, colC As Double

lRow = Sheets("Sheet1").Range("A" & 
         Sheets("Sheet1").Rows.Count).End(xlUp).Row
For i = 2 To lRow
    colA = Sheets("Sheet1").Range("A" & i).Value
    colB = Sheets("Sheet2").Range("B" & i).Value
    colC = Sheets("Sheet2").Range("C" & i).Value

    If colA >= colB Or colA <= colC Then
        Sheets("Sheet1").Range("G" & i).Value = Sheets("Sheet2").Range("D" & 
   i).Value
        Sheets("Sheet1").Range("H" & i).Value = Sheets("Sheet2").Range("E" & 
  i).Value
    End If
Next i

1 Ответ

1 голос
/ 27 мая 2019

Если столбец B в Sheet2 находится в порядке возрастания…

enter image description here

… это можно легко сделать с помощью формулы.В B2 добавьте следующую формулу и потяните ее вниз и вправо.

=INDEX(Sheet2!D:D,MATCH($A:$A,Sheet2!$B:$B,1))

И вы получите этот вывод в Sheet1:

enter image description here

Такой же подход возможен для VBA с использованием Application.WorksheetFunction, но я рекомендую использовать формулу.

VBA Solution

Option Explicit

Public Sub FindAndFillData()
    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("Sheet1")

    Dim wsLookup As Worksheet
    Set wsLookup = ThisWorkbook.Worksheets("Sheet2")

    Dim LastRow As Long
    LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row

    Dim MatchedRow As Double

    Dim iRow As Long
    For iRow = 2 To LastRow
        MatchedRow = 0 'initialize!
        On Error Resume Next
        MatchedRow = Application.WorksheetFunction.Match(wsDest.Cells(iRow, "A").Value, wsLookup.Columns("B"), 1)
        On Error GoTo 0

        If MatchedRow <> 0 Then
            If wsDest.Cells(iRow, "A").Value <= wsLookup.Cells(MatchedRow, "C").Value Then
                wsDest.Cells(iRow, "B").Value = wsLookup.Cells(MatchedRow, "D").Value
                wsDest.Cells(iRow, "C").Value = wsLookup.Cells(MatchedRow, "E").Value
            End If
        End If
    Next iRow
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...