为了代码的可读性，我使用了两个定制的functions，以及此处显示的主要过程。否则这将是一个巨大的代码转储。
在开始之前，您必须更改/检查这些数据字段。
- （蓝色）数据表需要命名为“
scores”（或将内部代码更改为您自己的名称）
- （绿色）成绩表也是如此 - 被命名为“
grades”并开始于F1
- 最后但并非最不重要的一点是，代码假定这两个表位于名为“
Sheet1”的表中
因此，如果名称不匹配，所有这些都需要在代码中进行更改！
现在到程序：
Option Explicit
Private Sub run_through_scores()
Dim scores As ListObject ' table from A1
Dim grades As ListObject ' table from F1
Set scores = Sheets("Sheet1").ListObjects("scores")
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range ' for "for" loop
Dim inrow As Long ' will store in which row the year is
Dim resultColumn As Integer ' will store in which column the percentage is
'for every cell in second column of scores table (except header)
For Each cell In scores.ListColumns(2).DataBodyRange
inrow = get_year(cell).Row - 1
' ^ returns Row where result was found, -1 to accoutn for header
'using our get_interval() function, _
determines in which column is the sought percentage
resultColumn = get_interval(cell.Offset(0, -1), inrow).Column
cell.Offset(0, 1) = Sheets("Sheet1").Cells(1, resultColumn)
'write result in Column C ^
Next cell
End Sub
以及功能：
get_year()
从 " " 表返回一个Range对象grades，我们在其中从 " " 表中找到匹配的年份scores。如果未找到所需年份，则返回最接近它的年份（表的最后一行）
' Returns a Range (coordinates) for where to search in second table
Private Function get_year(ByVal year As Variant) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim testcell As Range
Set testcell = grades.ListColumns(1).DataBodyRange.Find(year, LookIn:=xlValues)
'if found
If Not testcell Is Nothing Then
Set get_year = testcell
Else
Dim tbl_last_row As Long 'if year not found, return last row
tbl_last_row = grades.ListColumns(1).DataBodyRange.Rows.Count
Set get_year = grades.ListColumns(1).Range(tbl_last_row)
End If
End Function
第二个功能：
get_interval()
从“ ”表中返回一个Range对象。grades它比较各个单元格范围并返回 a）如果从“ scores”中寻找的百分比小于或等于（<=）然后当前单元格百分比或 b）如果我们遍历所有单元格，它返回最后一个单元格
（因为它必须更高，大于指定间隔的最大值）
Private Function get_interval(ByVal what As Variant, ByVal inyear As Long) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range
For Each cell In grades.ListRows(inyear).Range
'check for interval
If what <= cell And cell.Column <> 6 Then 'we don't want to check year column
Set get_interval = cell
Exit Function
End If
Next cell
' if we arrived here, at this stage the result will always be the last cell
Set get_interval = grades.ListRows(inyear).Range(, grades.ListColumns.Count)
End Function
在触发（调用）run_through_scores()过程后，我们得到了预期的结果：
如果您有任何问题，请告诉我:)