在另一个范围内查找范围条件

时间:2017-06-21 15:13:14

标签: excel-vba vlookup vba excel

我在两本工作簿之间工作 xl1是这样的例行工作簿

StudentID |From |To  
1         |2    |9  
2         |20   |50  
3         |0    |1 

xl2是另一个工作簿,如下所示:

From| To     
0   | 1.5  'Associate 1 with this as an ID
2   | 15   'Associate 2 with this as an ID and so on

我正在尝试在xl1中编写一个让我

的代码
  
      
  1. 选择xl2工作簿

  2.   
  3. 查找列From和To

  4.   
  5. 签入xl1工作簿,查看每个学生的From和To是否属于xl2的From和To范围,然后将ID关联到   它。为了说清楚(如下所示):

  6.   
StudentID |From |To  |ID  
1         |2    |9   |2  
2         |20   |50  |  
3         |0    |1   |1  

到目前为止,我已经编写了这段代码,但我似乎无法弄清楚如何获得逻辑:

Sub getID()
Dim wb As Workbook
Dim ws As Worksheet
Dim fd As FileDialog
Dim filename As String
Dim rng As Integer
Dim counter As Integer
Dim frm As Range
Dim too As Range
Dim lngCount As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Application.ScreenUpdating = False
Application.DisplayAlerts = False


With fd

If .Show Then
       FileName = .SelectedItems(1)
    Else
       'if user pressed CANCEL - exit sub
       MsgBox "User pressed CANCEL"
       Exit Sub
    End If
                On Error Resume Next
                Set wb = Workbooks.Open(FileName)
                rng = ActiveSheet.UsedRange.Rows.Count 
                frm = ActiveSheet.Range("AA" & rng).Select   'copy from col
                too = ActiveSheet.Rang("AC" & rng).Select    'copy to col
                For Each Cell In frm
                    if()
                Next Cell

            Next
End If
End With


End Sub  

该示例基本上意味着

xl2.from<xl1.from<xl2.to 

xl2.from<xl1.to<xl2.to

我很感激帮助您实现这一目标

1 个答案:

答案 0 :(得分:1)

因此,这会将第一个文件中的每个数据集与第二个文件进行比较。并在D列中给出匹配的ID。您没有说过多个匹配,所以它会将所有匹配放在单元格中,并用“;”分隔它们。

Sub getID()
Dim wb As Workbook
Dim sht As Worksheet, sht2 As Worksheet
Dim fd As FileDialog
Dim lRow As Long, lRow2 as Long
Dim i as Integer, j as Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set sht = ActiveWorkbook.ActiveSheet

With fd
    .AllowMultiSelect = False
    .Filters.Add "Excel", "*.xl*"
End With

If fd.Show = -1 Then

    Set wb = Workbooks.Open(fd.SelectedItems(1))
    Set sht2 = wb.Worksheets(1) 'First Sheet in File

    lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
    LRow2 = sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Row

    sht.Columns(4).ClearContents 'Clear Old Data in Column "D"
    sht.Cells(1, 4).Value = "ID" 'Title of Col

    For i = 2 To lRow
        For j = 2 To LRow2
            If sht.Cells(i, 2).Value >= sht2.Cells(j, 1).Value _
            And sht.Cells(i, 3).Value <= sht2.Cells(j, 2).Value Then 'Checks if From and To are in Range
               If sht.Cells(i, 4).Value <> "" Then 'if more than one ID
                    sht.Cells(i, 4).Value = sht.Cells(i, 4).Value & ";" & j - 1  'Seperate ID with ";" ID
                Else
                    sht.Cells(i, 4).Value = j - 1 'ID
                End If
            End If
        Next j
    Next i

    wb.Close
End If
End Sub

第一个文件如下所示:

enter image description here

第二个文件如下所示:

enter image description here

(注意:我使用德语版本,因此有“,”代表小数而不是“。”)