VBA查找全选，然后将所有相邻单元格向右移动

我正在尝试编写一个宏，它将对工作系统生成的工作簿进行排序。我曾试图将本网站其他帖子中的一些代码拼凑在一起，但没有成功

目标是在A列中搜索包含“IN”或“OUT”的任何单元格，然后将这些单元格的所有内容向右移动一个单元格

我有一些代码可以用于第一次输出，但它只会在第一次输出时准备好。我知道为什么它不工作，但我不知道如何修复它

任何帮助都将不胜感激， 谢谢

编辑 这是我想要更改的文件的模型，通常会有几百个批次和更多的列，但它应该是可行的。

---

您可以通过一个简单的循环来完成，而不是使用Find函数：

Dim i as Long, LR as Long
LR = Cells(Rows.Count,1).End(xlUp).Row
For i = 2 to LR 'Assumes you have a header in row 1
    If Cells(i,1).Value = "IN" OR Cells(i,1).Value = "OUT" Then
        Cells(i,2).Insert Shift:=xlToRight 
    End If
Next i

请注意，输入和输出区分大小写

您也可以使用Find函数来实现这一点，尽管您可以查找全部，或者使用Find next，并使用.insert，就像您在代码中所做的那样

---

编辑：

假设问题是隐藏字符，可以使用InStr：

Dim i As Long, LR As Long, j As Integer, k As Integer
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR 'Assumes you have a header in row 1
    j = InStr(Cells(i, 1).Value, "IN")
    k = InStr(Cells(i, 1).Value, "OUT")
    If j > 0 Or k > 0 Then
        Cells(i, 2).Insert Shift:=xlToRight
    End If
Next i

---

如果您想使用

Find

功能，则可以执行类似的操作

Option Explicit

Public Sub Data_only()
    MoveByFind "IN"
    MoveByFind "OUT"
End Sub

Public Function MoveByFind(FindString As String)
    Dim Found As Range
    Set Found = Columns("A:A").Find(What:=FindString, LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Not Found Is Nothing Then
        Dim firstAddress As String
        firstAddress = Found.Address 'remember first find for no endless loop

        Do
            Found.Offset(0, 1).Insert Shift:=xlToRight 'move cells right
            Set Found = Columns("A:A").FindNext(After:=Found) 'find next
        Loop While Not Found Is Nothing And Found.Address <> firstAddress 'loop until end or nothing found
    End If
End Function

选项显式
公共子数据_only（）
MoveByFind“IN”
MoveByFind“OUT”
端接头
公共函数MoveByFind（FindString作为字符串）
作为射程找到的昏暗
Set Found=Columns（“A:A”）.Find（What:=FindString，LookIn:=xlFormulas，LookAt:=xlWhole_
SearchOrder:=xlByRows，SearchDirection:=xlNext，MatchCase:=False，SearchFormat:=False）
如果找不到，那就什么都没有了
将第一个地址设置为字符串
firstAddress=Found.Address“记住第一次查找，无循环”
做
找到。偏移量（0，1）。插入移位：=xlToRight'将单元格向右移动
Set Found=Columns（“A:A”）.FindNext（之后：=Found）'find next
未找到的循环为Nothing And Found。Address firstAddress循环直到结束或未找到任何内容
如果结束
端函数

您是否尝试录制自己的宏并查看Excel为您提供了什么？是的，我有，这就是我获得搜索功能的地方，它比我读到的一些东西更容易理解。请注意，假设列A具有连续数据，而最后一行（LR）可以动态确定。如果您声明

Dim I，LR为整数

则只有最后一个是

Integer

，但

i

将为

Variant

它与

Dim i为Variant，LR为整数

完全相同。尤其是在迭代行时。Excel的行数超出了

Integer

所能处理的范围！改为使用

Dim i As Long，LR As Long

。@Peh我认为整数和Long是内存问题？我知道我应该使用LR来处理大数据（在这段代码中应该这样做）。关于Dim i，LR是整数，我的印象是字符串中的所有内容都被认为是整数。。。显然这是错的？谢谢你回到我这里，我已经输入了你添加的代码，但它似乎没有任何作用，我添加了一张我用来测试的文件的图片。@FlippentGod First评论说这些案例是敏感的；你有没有像你的文件显示那样把“In”改为“In”和“Out”改为“Out”？谢谢这在测试中起到了作用我要在一个真实的测试上运行它看看会发生什么。它起作用了你把我一天的时间都缩短了谢谢，

Option Explicit

Public Sub Data_only()
    MoveByFind "IN"
    MoveByFind "OUT"
End Sub

Public Function MoveByFind(FindString As String)
    Dim Found As Range
    Set Found = Columns("A:A").Find(What:=FindString, LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Not Found Is Nothing Then
        Dim firstAddress As String
        firstAddress = Found.Address 'remember first find for no endless loop

        Do
            Found.Offset(0, 1).Insert Shift:=xlToRight 'move cells right
            Set Found = Columns("A:A").FindNext(After:=Found) 'find next
        Loop While Not Found Is Nothing And Found.Address <> firstAddress 'loop until end or nothing found
    End If
End Function