gpt4 book ai didi

excel - VBA在循环中按新行拆分单元格

转载 作者:行者123 更新时间:2023-12-04 21:14:27 25 4
gpt4 key购买 nike

VBA 的新手,试图创建一个函数,该函数本质上是在列中搜索某些值。如果找到命中,则返回相应的列,否则返回空格。工作表的格式化方式,一个单元格可以有多个值(由 ALT+ENTER 分隔,因此每个新值都在单独的行上)。

我目前使用的代码有效,但有一个问题:
由于我使用的是 inStr ,因此代码也返回了部分匹配项(我不想要)。

Example:
**Column to Search (one cell)**
ABC
AB
B

当我运行代码以查找 AB 时,它将返回 AB 和 ABC 的命中,因为 AB 是其中的一部分。

理想的解决方案是首先根据 ALT+ENTER 拆分单元格并遍历每个单元格的所有值,然后返回所需的值。但不是语法的外观。

当前代码
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String
Dim mRange As Range
Dim mValue As String

For i = 1 To Search_in_col.Count

If InStr(1, Search_in_col.Cells(i, 1).Text, Search_string) <> 0 Then
If (Return_val_col.Cells(i, 1).MergeCells) Then

Set mRange = Return_val_col.Cells(i, 1).MergeArea
mValue = mRange.Cells(1).Value

result = result & mValue & ", "
Else
result = result & Return_val_col.Cells(i, 1).Value & ", "
End If
End If

Next

例子:
添加示例以更好地说明情况

example

最佳答案

您可以拆分字符串并循环。

Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String


If Search_in_col.Cells.Count <> Return_val_col.Cells.Count Then Exit Function

Dim sptStr() As String
sptStr = Split(Search_string, Chr(10))

Dim srchArr() As Variant
srchArr = Search_in_col.Value

Dim RetArr() As Variant
RetArr = Return_val_col.Value

Dim i As Long
For i = LBound(sptStr) To UBound(sptStr)
Dim j As Long
For j = LBound(srchArr, 1) To UBound(srchArr, 1)
If srchArr(j, 1) = sptStr(i) Then
newFunc = newFunc & RetArr(j, 1) & ", "
End If
Next j
Next i

newFunc = Left(newFunc, Len(newFunc) - 2)


End Function

enter image description here

编辑:

根据新信息:
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String

Search_string = "|" & Search_string & "|"

Dim srchArr() As Variant
srchArr = Search_in_col.Value

Dim RetArr() As Variant
RetArr = Return_val_col.Value

Dim i As Long
For i = LBound(srchArr, 1) To UBound(srchArr, 1)
Dim T As String
T = "|" & Replace(srchArr(i, 1), Chr(10), "|") & "|"

If InStr(T, Search_string) > 0 Then
newFunc = newFunc & RetArr(i, 1) & ", "
End If

Next i

newFunc = Left(newFunc, Len(newFunc) - 2)
End Function

enter image description here

关于excel - VBA在循环中按新行拆分单元格,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53507325/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com