基于其他表格填充单元格

我试图自动化Excel文件中的某些function。

这是我的问题:

简化的例子

表1包含一个string是列“信息”,后面跟着两个空单元格。 对于表1中的每一行,我想检查表1的“信息”列中是否存在表2列“水果”的值。如果是,我想填写“颜色”和“价格“表2中的空单元格中的表1。

例如,第二行包含“香蕉”一词,表示“颜色”“黄色”和“价格”“15”应填写在表1第2行的相同列中。

不知怎的,这个问题对我来说似乎很简单,但是当我开始考虑如何实现这个时,我就陷入了困境。 所以不幸的是,我没有任何可以修复的代码。 我只是希望这个问题不是太模糊。

我也尝试使用公式解决这个问题,使用MATCH和INDEX,但我无法得到这个工作。

这是一个函数,它将返回ListObject(Table)中find第一个匹配单词的行。

 Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long Dim vaSplit As Variant Dim i As Long, j As Long Dim rFound As Range Dim sWhat As String vaSplit = Split(sInfo, Space(1)) For i = LBound(vaSplit) To UBound(vaSplit) 'strip out non-alpha characters sWhat = vbNullString For j = 1 To Len(vaSplit(i)) If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then sWhat = sWhat & Mid(vaSplit(i), j, 1) End If Next j 'find the word in the range Set rFound = Nothing Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False) If Not rFound Is Nothing Then 'if it's found 'return the row in the ListObject MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row 'stop looking Exit For End If Next i End Function 

假设你的第一张桌子叫做tblData,而你的第二张桌子是tblFruit,你会得到使用的颜色

 =INDEX(tblFruit[Color],MatchFruit([@Info],tblFruit[Fruit])) 

和价格类似

 =INDEX(tblFruit[Price],MatchFruit([@Info],tblFruit[Fruit])) 

长的解释

vaSplit赋值行使用Split函数将string转换为基于分隔符的数组。 由于您的示例数据是句子,正常的分隔符是一个空格将其分成单词。 像一个string

 This is some line about apples. 

被转换成一个数组

 vaSplit(1) This vaSplit(2) is vaSplit(3) some vaSplit(4) line vaSplit(5) about vaSplit(6) apples. 

接下来, For循环遍历数组中的每个元素,看它是否可以在另一个列表中find它。 函数LBoundUbound (下边界和上边界)被使用,因为我们不能确定数组有多less个元素。

循环内的第一个操作是摆脱任何多余的字符。 为此,我们创buildvariablessWhat并将其设置为无。 然后我们循环遍历元素中的所有字符,看看是否在范围之外。 基本上,任何一个字母都会被附加到sWhat而不是(数字,空格,句号)不是。 最后sWhat和所有非alpha字符去掉的当前元素相同。 在这个例子中,我们永远不会匹配apples. 由于这个时期,所以它被剥夺了。

一旦我们有了一个好的sWhat ,我们现在使用Find方法来查看这个单词是否存在于rFruit范围内。 如果是这样,那么rFound不会是Nothing ,我们前进。

请注意,如果在范围内找不到该单词,则rFound将为Nothing并且该函数将返回零。

如果find该单词,则函数返回在ListObject开始的行更less的行上find的行。 这样,函数返回的是与ListObject的数据不在工作表上的行。 将其纳入INDEX公式时非常有用。 为了让一个公式返回一些东西,你可以给公式的名称赋予一些东西。

最后,一旦find匹配项, Exit For行就会停止查看数组。 如果您的数据中有多个匹配项,则只会返回第一个匹配项。

故障排除

你会发现最可能的错误是,当你期望它返回一个行号时,函数将返回零。 这很可能意味着它没有在列表中find任何单词。

如果您确定两个列表都包含匹配的单词,请按照以下方法排除故障:在Set rFound =行之后放置一个Debug.Print语句。

  Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False) Debug.Print "." & sWhat & "." If Not rFound Is Nothing Then 'if it's found 

这将打印到即时窗口(VBE中的Ctrl + G来查看即时窗口)。 周围的时期是这样,你可以看到任何不可打印的字符(如空格)。 如果你尝试匹配.pears .pears不匹配,因为第一个有一个空间在最后 – 你可以看到,因为我们卡住了前后期。

如果空格将成为问题,可以使用sWhat上的Trim$()函数来首先摆脱它们。

使用该Debug.Print语句,您可能会看到类似的结果

 .paers. 

在这种情况下会认识到你有一个错字。

给迪克和其他可能感兴趣的人。 就像我在上次对@ Dick-Kusleika提供的答案中所提到的那样,他的回答并没有完全覆盖我最初的问题。 尽pipe它给了我很大的洞察力,并且用适当的数据完成了填充空单元格的工作,但是我确实在寻找能够自动完成的工作,而不必复制粘贴任何公式。 所以,我花了一些时间试图弄清楚,从互联网上获得信息,并与同事分享我的兴趣。 最终我设法让它工作! (欢呼!!)

以下是我的解决scheme。 因为我还是个初学者,所以我可能做了一些本来可以做得更好或更清洁的事情。 所以我对你对此的看法很感兴趣,并且很乐意听到任何评论或提示。

 Sub check_fruit() Dim ws As Excel.Worksheet Dim lo_Data As Excel.ListObject Dim lo_Fruit As Excel.ListObject Dim lr_Data As Excel.ListRow Dim lr_Fruit As Excel.ListRow Dim d_Info As Variant Dim f_Fruit As Variant Set ws = ThisWorkbook.Worksheets("Exercise") Set lo_Data = ws.ListObjects("tblData") Set lo_Fruit = ws.ListObjects("tblFruit") For Each lr_Data In lo_Data.ListRows 'check if field "Color" is empty in tblData' If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value For Each lr_Fruit In lo_Fruit.ListRows f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value 'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData' If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value End If Next lr_Fruit End If Next lr_Data End Sub