Excel VBA找很多人物的任何一个

在Excel 2011 for Mac中,我可以如何find其中包含任何这些字符的下一个单元格:

ÀÁÂÃÄÅàáâãäåÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöÙÚÛÜùúûüÝýÿ

(这些字符中的一个或多个将被embedded到单元格中的其他string中,例如Málaga桌面)

我会手动重新运行,find下一个单元格,直到没有更多的命中。

点击感兴趣的列中的一个单元格。 反复运行这个macros会让你走下列find每个出现的所需字符:

Sub ytrewq() Dim s As String, r As Range, rng As Range, N As Long Dim v As String, CH As String, i As Long s = "ÀÁÂÃÄÅàáâãäåÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöÙÚÛÜùúûüÝýÿ" N = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row Set rng = Range(ActiveCell, Cells(N, ActiveCell.Column)) For Each r In rng v = r.Text If v <> "" Then For i = 1 To Len(v) CH = Mid(v, i, 1) If InStr(s, CH) > 0 Then r.Select Exit Sub End If Next i End If Next r MsgBox "NO MORE CHARACTERS FOUND" End Sub 

编辑#1:

这个版本将涵盖所有UsedRange:

 Public lastfound As Range Sub ytrewq() Dim s As String, r As Range, rng As Range, start As Boolean Dim v As String, CH As String, i As Long, st As String s = "ÀÁÂÃÄÅàáâãäåÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöÙÚÛÜùúûüÝýÿ" Set rng = ActiveSheet.UsedRange start = False On Error Resume Next st = lastfound.Address(0, 0) On Error GoTo 0 If st = "" Then Set lastfound = rng(1) End If For Each r In rng If start Then v = r.Text If v <> "" Then For i = 1 To Len(v) CH = Mid(v, i, 1) If InStr(s, CH) > 0 Then r.Select Set lastfound = Selection Exit Sub End If Next i End If End If If r.Address(0, 0) = lastfound.Address(0, 0) Then start = True End If Next r MsgBox "NO MORE CHARACTERS FOUND" End Sub 

编辑#2:

以上的行为是一旦检测到NOT FOUND条件就挂断。 以下版本(在最后添加一行代码)将允许从头开始重新开始:

 Public lastfound As Range Sub ytrewq() Dim s As String, r As Range, rng As Range, start As Boolean Dim v As String, CH As String, i As Long, st As String s = "ÀÁÂÃÄÅàáâãäåÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöÙÚÛÜùúûüÝýÿ" Set rng = ActiveSheet.UsedRange start = False On Error Resume Next st = lastfound.Address(0, 0) On Error GoTo 0 If st = "" Then Set lastfound = rng(1) End If For Each r In rng If start Then v = r.Text If v <> "" Then For i = 1 To Len(v) CH = Mid(v, i, 1) If InStr(s, CH) > 0 Then r.Select Set lastfound = Selection Exit Sub End If Next i End If End If If r.Address(0, 0) = lastfound.Address(0, 0) Then start = True End If Next r MsgBox "NO MORE CHARACTERS FOUND" Set lastfound = Nothing End Sub 

FIND()中的构build不支持这一点。

就像发现这个UDF返回的任何其他字符的第一次出现的位置#VALUE!

添加一个VBA模块并粘贴:

 Public Function ContainsAccented(value As String) As Long Const chars As String = "ÀÁÂÃÄÅàáâãäåÈÉÊËèéêëÌÍÎÏìíîïÑñÒÓÔÕÖòóôõöÙÚÛÜùúûüÝýÿ" If value Like "*[" & chars & "]*" Then For ContainsAccented = 1 To Len(value) If InStr(1, chars, Mid$(value, ContainsAccented, 1)) Then Exit Function Next End If ContainsAccented = CVErr(xlErrValue) End Function 

然后使用=ContainsAccented(A1)