求VBA高手：用VBA实现 在excel某一固定列中 筛选出相差一个或多个字符的单元格 自动填充到同一行

Question

希望将A列中的每一单元格都与该列中的数据进行对比，筛选出与该单元格相差一个或多个字符的单元格 ，自动填充到同一行（如后图所示）。愿越详细越好，我对VBA真的一窍不通。另外，若不用VBA，只用函数是否可实现？
补：关于“相差一个或多个字符的单元格”
比如我想找出与123相差一个字符的单元格，其可能的数值就有： *123，1*23，12*3，123* *12，12*，*23，23* 12，23 其中的星号可以是 0-9任意数字 或 a-z任意字母以此类推，若要找出与123相差两个字符的单元格，其可能的数值就有： **123，1**23，12**3，123** **12，12**，**23，23** 1，2，3 其中的星号可以是 0-9任意数字 或 a-z任意字母
A列单元格字符长度最长为20， 与123相差两个字符的单元格，其可能的数值 除了
**123，1**23，12**3，123**
**12，12**，**23，23**
1，2，3
之外
应该还有1*2*3
其中的星号可以是 0-9任意数字 或 a-z任意字母

Answer 1

Sub aa()
Dim i&, j&, k%, n, str$
Range("b:z").ClearContents
n = Application.InputBox("请输入搜索相差范围", "搜索相差范围", 1, Type:=1)
If n = "False" Then Exit Sub
For i = 1 To [a65536].End(xlUp).Row
    For j = 1 To [a65536].End(xlUp).Row
        If i <> j Then
           If Len(Range("a" & i)) = Len(Range("a" & j)) - n Then
              If InStr(1, Range("A" & j), Range("a" & i), vbTextCompare) <> 0 Then
                 Cells(i, 256).End(xlToLeft).Offset(, 1) = Range("A" & j)
              End If
           ElseIf Len(Range("a" & i)) >= Len(Range("a" & j)) Then
              For k = 1 To Len(Range("A" & i)) - n
                  str = Mid(Range("A" & i), k, Len(Range("A" & i)) - n)
                  If str = Range("A" & j).Value Or InStr(1, Range("a" & j), str, vbTextCompare) <> 0 Then
                     Cells(i, 256).End(xlToLeft).Offset(, 1) = Range("A" & j)
                     Exit For
                  End If
              Next k
           End If
        End If
    Next j
Next i
End Sub

试试这个呢？

追问

对于这组程序由于我不了解VBA，所以没法去试，不过还是谢谢了

Answer 2

打开下载的附件按ALT+F8选中执行即可获得你要的结果,(把要对比的数复制到A列)

按ALT+F11可以看到VBA代码.代码为工作表代码,

追问

十分感谢！我在一个步骤 “请输入搜索相差范围“ 输入1时可很好地执行，
但输入 2或3等的时候却显示“无效的过程调用或参数”
求解

追答

哦 原因找到了.

是因为单元格内值的位数小于你设定的相差范围,

这种情况我忘记处理了.

重新给你发个附件.你试试吧修改好了

本回答被提问者采纳