Question

在此项目中，我必须检查列B和列C之间的列A值。如果列A的值> =列B的值或列A值<=列C的值，那么我需要复制列d和e的值，并且需要分别在工作表1的G和H列中放置。列A在工作表1中，列B，C，D和E在工作表2中。

   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

Answer 1

如果Sheet2中的B列按升序排列……

...您可以使用公式轻松地做到这一点。在B2中，添加以下公式并将其向右下拉。

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

您将在Sheet1中得到以下输出：

使用Application.WorksheetFunction的VBA也可以使用相同的方法，但是我建议使用公式。

VBA解决方案

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

返回值是否在范围内？

1 个答案:

VBA解决方案