Excel VBA – search一个特定的字符，select没有这个字符的任何非空单元格，在选定的单元格上执行第二个子例程

我是Excel VBA的新手（到目前为止只有一个正式课程），我一直在试图用这个和其他Excel网站收集的零碎拼凑一个VBAmacros，但是几天后，已经陷入僵局。

我在做什么：

• search列C，D，E，G，H，I，K，L为字符“°”，从第6行开始，以第200行结束，对于上述各列。
• 如果在上述范围内的任何单元格中出现“°”，则不对该单元格执行任何操作。
• 如果该单元格完全是空的，则不对该单元格采取任何行动。
• 如果在上述范围内的任何一个单元格中没有出现“°”，并且该单元格不是完全空的，则select或激活该单元格，并调用第二个子程序。
• 第二个子程序将“°”字符放在单元格的第5个位置（相当于按F2，向左移动5个位置并插入“°”）。

我写的最新版本：

Sub CheckTestColC() Dim a As String Dim cell As C6: C200 For Each cell In Selection If InStr(1, cell, "°", 1) Then Cells(ActiveCell.Row + 1, ActiveCell.Column).Select Else ActiveCell.Value = a Call AddDegree End If Next End Sub Sub AddDegree() SendKeys "{F2}" Application.Wait (Now() + TimeValue("00:00:01")) SendKeys "{LEFT 5}" Application.Wait (Now() + TimeValue("00:00:01")) SendKeys "°" Application.Wait (Now() + TimeValue("00:00:01")) SendKeys "{ENTER}" End Sub 

再次，我是一个完全的新手，所以我提前道歉，如果我的编码似乎荒谬你有经验的人。 😉

我很高兴看到上述代码的更正，或者如果有更好/更强/更快的方式来解决这个问题，请使用完全不同的path，请引导我朝正确的方向发展。 我非常想学习！ 🙂

Answer 1

既然你说你对VBA是如此的新鲜，这里就是你的一个代码示例，它展示了一些值得学习的概念。

1. 从你的input中抽象出你的逻辑。 这样你可以更容易地重用代码
2. 限制范围内循环的大小（它们很慢 ）。 SpecialCells有助于减less感兴趣的潜在细胞的范围。 更好的是，使用一个Variant数组（在SO上查看）
3. 不要使用SendKeys。 永远。 （好吧，除非你真的有一个很好的理由）
4. 处理潜在的inputexception

---

 Sub Demo() ' Process Rows 6:200 of columns C, D, E, G, H, I, K, L on active sheet FindDeg Range("C6:E200"), "°", 5, False FindDeg Range("G6:I200"), "°", 5, False FindDeg Range("K6:L200"), "°", 5, False End Sub Private Sub FindDeg(rng As Range, InsertString As String, AtPosition As Long, Optional FromLeft As Boolean = True) Dim rngTextCells As Range, cl As Range Dim str As String ' Select non-blank cells containing text ' (ie ignore formulas, numbers and errors) On Error Resume Next Set rngTextCells = rng.SpecialCells(xlCellTypeConstants, xlTextValues) Err.Clear On Error GoTo 0 ' If any found If Not rngTextCells Is Nothing Then ' Loop through cells For Each cl In rngTextCells If Not cl.Value Like "*" & InsertString & "*" Then ' Cell does not contain ° str = CStr(cl.Value) If Len(str) < AtPosition Then ' what if it's too short? MsgBox "cell = " & str & vbNewLine & "What now?" Exit Function End If ' Insert string at position (no need to that SensKeys nonsense If FromLeft Then cl = Left$(str, AtPosition) & InsertString & Mid$(str, AtPosition + 1) Else cl = Left$(str, Len(str) - AtPosition) & InsertString & Right$(str, AtPosition) End If End If Next End If End Sub 

Answer 2

下面的例子需要一些调整，但它接近你所需要的。

我使用了简单的技巧，您应该能够理解，也许有一些googleing。 使用Excel VBA查找帮助，而不使用Excel。 VBA不通过键盘与Excel交谈（即忘记SendKeys ），并不需要select单元格来修改它们（即忘记Select ）。

对于VBA，每个单元格，工作表，工作簿，范围，字体，图表等都是对象。 您可以使用他们的方法和属性“读取”或“写入”它们。

 Sub CheckTestColC() Dim R As Integer, C As Integer, CLetter As String For C = 1 To 10 CLetter = Chr(C + 64) If InStr("CDEGHIKL", CLetter) = 0 Then GoTo SkipColumn For R = 6 To 200 If IsEmpty(Cells(R, C)) Then GoTo SkipRow If InStr(Cells(R, C).Value, "°") Then GoTo SkipRow Cells(R, C).Value = ModifyValue(Cells(R, C).Value) SkipRow: Next R SkipColumn: Next C End Sub Function ModifyValue(Txt As String) ModifyValue = Left(Txt, 4) & "°" & Mid(Txt, 5) End Function 

Answer 3

我不会使用SendKeys，因为它需要用户在完成之前根本不使用机器，并且任何其他中断（如popup窗口）也会打断它。 我会用Left（）和Right（）来代替。 这种方法也不需要激活单元。

你看起来并没有像你解释的那样检查单元格的内容。

variables“a”没有赋值，所以你实际上正在使用它来消隐单元格。

“单元格（ActiveCell.Row + 1，ActiveCell.Column）。select”不select单元格“单元格”是指，它将继续select下一个单元格。

这里是一个粗略的重写，我没有在这台机器上的Excel，但这更接近你解释的逻辑（不需要第二个子）。 此版本要求单元格内容至less为5个字符以满足您的5端到端标准

 Sub CheckTestColC() Dim cell As C6: C200 For Each cell In Selection If InStr(cell, "°")<1 And Len(cell)>=5 Then 'cell.Select 'Not required cell=Left(cell,len(cell)-5) & "°" & Right(cell,5) End If Next End Sub 

Answer 4

欢迎来到StackOverflow并做好你的问题和学习到最新的！

就“更强/更好/更快”

• 避免在单元格范围内循环，而是使用变体数组来进行操作
• 避开Sendkeys,这是kludgy
• 在添加到第5个位置的string之前，先testing它至less是4个字符
• 使用string函数Left$而不是较慢的变体Left

这段代码在你的整个范围内工作，跳过F和J列

 Sub Uppdate() Dim X Dim rng1 As Range Dim lngCol As Long Dim lngRow As Long 'set initial range Set rng1 = Range("C6:L200") 'put range in variant X = rng1.Value2 For lngCol = 1 To UBound(X, 2) For lngRow = 1 To UBound(X, 1) 'skip every fourth column (F and J) If lngCol Mod 4 <> 0 Then 'skip values containing "°" If InStr(X(lngRow, lngCol), "°") = 0 Then 'replace is string is 4 or more characters If Len(X(lngRow, lngCol)) > 3 Then X(lngRow, lngCol) = Left$(X(lngRow, lngCol), 4) & "°" & Right$(X(lngRow, lngCol), Len(X(lngRow, lngCol)) - 4) End If End If End If Next lngRow Next lngCol 'dump back to range rng1 = X End Sub