excel 标识单元格中要返回值的文本

7ajki6be  于 2023-03-13  发布在  其他
关注(0)|答案(3)|浏览(125)

我试图确定一个单元格是否包含某个文本字符串,以返回同一行上另一个单元格中的值。
我得到一个不匹配错误。

Sub iflocate_school1()

Dim MailValue As String
Dim EcoleValue As String

MailValue = Range("C7:C725").Value

EcoleValue = Range("E7:E725").Value

If MailValue Like "Cambridge.ac" Then
EcoleValue = "Cambridge"

ElseIf MailValue Like "imperial" Then
EcoleValue = "Imperial"

ElseIf MailValue Like "oxford" Then
EcoleValue = "Oxford"

ElseIf MailValue Like "lse" Then
EcoleValue = "LSE"

ElseIf MailValue Like "york" Then
EcoleValue = "York"

Else EcoleValue = " "

End If

End Sub
uz75evzq

uz75evzq1#

请检查下面的脚本。请注意,该脚本假定您正在处理当前活动工作簿的工作表(1)。
您收到不匹配错误:

"A VBA Type Mismatch Error occurs when you try to assign a value between two 
different variable types"

正如我在评论部分提到的,您得到的错误是由于将值的范围数组存储到字符串变量中。
下面的代码将range(“C7:C725”)存储到一个range对象(来自上面的示例)中,然后我使用您创建的if语句对range(“C7:C725”)中的每个单元格执行一个循环。
if语句结果将出现在下一列cel,(offset(0,1))so range(“D7:D725”)。如果希望结果显示在列(“E7:E725”)上,请将offset更改为(0,2)。
请使用以下代码:

Sub foo()

Dim wb As Workbook

'dim range object, instead of a string variable
Dim mailvalue As Range
Dim cel As Range

Set wb = ThisWorkbook

'setting the range("C7:C725") into the dim range (mailvalue) created above
'change the sheet number or the range as you need
Set mailvalue = wb.Sheets(1).Range("C7:C725")

    For Each cel In mailvalue
    
        'all the if statement result will show in the next column (col D) of cel being iterated (cel.offset(0,1) where .offset(row,col))
        'change the offset as needed, on your script above seems like you want output in column E, so I would change from offset(0,1) to offset(0,2).
        If cel.Value Like "Cambridge.ac" Then
            cel.Offset(0, 1).Value = "Cambridge"
    
        ElseIf cel.Value Like "imperial" Then
            cel.Offset(0, 1).Value = "Imperial"
    
        ElseIf cel.Value Like "oxford" Then
            cel.Offset(0, 1).Value = "Oxford"
    
        ElseIf cel.Value Like "lse" Then
            cel.Offset(0, 1).Value = "LSE"
    
        ElseIf cel.Value Like "york" Then
            cel.Offset(0, 1).Value = "York"
    
        Else
            cel.Offset(0, 1).Value = " "

        End If

    Next cel

End Sub

最后,if语句看起来只不过是首字母大写,而“Else If”列表可能会增长到数百个,如果你创建了一个首字母大写的函数,那么就有可能删除整个if语句部分。
您可以添加一个首字母大写的函数:

Function capstr(s As String) As String

Dim s1 As String
Dim s2 As String

    s1 = UCase(Left(s, 1))
    s2 = Right(s, Len(s) - 1)

    capstr = s1 + s2

End Function

并将代码简化为:

Sub foo()

Dim wb As Workbook

Dim mailvalue As Range
Dim cel As Range

Set wb = ThisWorkbook

Set mailvalue = wb.Sheets(1).Range("C7:C725")

    For Each cel In mailvalue

        If cel.Value <> "" Then

            cel.Offset(0, 2).Value = capstr(cel.Value)

        Else

            cel.Offset(0, 2).Value = ""

        End if
    
    Next cel

End Sub
wztqucjr

wztqucjr2#

这就是我的方法。
阅读注解并根据需要调整代码

Public Sub iflocate_school1()

    Dim mailRange As Range
    Dim mailCell As Range
    
    Dim sheetName As String
    Dim mailRangeAddress As String
    
    Dim valuesToReplace(4) As Variant ' Set the (4) to the number of items you want to replace minus 1 as array index is base 0
    
    
    ' Adjust these values to fit your needs
    
    sheetName = "Sheet1"
    mailRangeAddress = "C7:C725"
    
    valuesToReplace(0) = Array("Cambridge.ac", "Cambridge")
    valuesToReplace(1) = Array("imperial", "Imperial")
    valuesToReplace(2) = Array("oxford", "Oxford")
    valuesToReplace(3) = Array("lse", "LSE")
    valuesToReplace(4) = Array("york", "York")
    
    
    Set mailRange = ThisWorkbook.Worksheets(sheetName).Range(mailRangeAddress)
    
    ' Loop through each cell in range
    For Each mailCell In mailRange
    
        ' Check if cell has any of the values
        Dim counter As Integer
        For counter = 0 To UBound(valuesToReplace)
            
            Dim replaceValue As String
            ' This -> valuesToReplace(counter)(0) is the first value of the first item (when counter = 0)
            If InStr(mailCell.value, valuesToReplace(counter)(0)) > 0 Then
                
                ' This -> valuesToReplace(counter)(1) is the second value of the first item (when counter = 0)
                replaceValue = valuesToReplace(counter)(1)
                
            End If
            
            mailCell.Offset(0, 2).value = replaceValue
        
        Next counter
    
    Next mailCell

End Sub
ljsrvy3e

ljsrvy3e3#

或者,我认为您可以对行进行迭代.
我认为问题可能是Like命令返回了一个值。
试试看:

If MailValue Like "Cambridge.ac" = "True" Then EcoleValue = "Cambridge"

同样,如果你在代码中改变行,下划线键就像回车一样,即,

If MailValue Like "Cambridge.ac" = "True" _ 
Then EcoleValue = "Cambridge"

或者,我认为您可以对行进行迭代.

Dim i as integer
i=7
Do while Cells(i,3) <> ""
 If instr((cells,i),"Cambridge.ac") >0 then Cells(i,4) = "Cambridge"
 If instr((cells,i),"imperial") >0 then Cells(i,4) = "imperial"
Loop

我不确定使用的范围,我可能不是那么先进。

相关问题