数值，排列问题，求助大神帮帮忙，谢谢！！已重复描述问题，添加图片了。

yjh_27

珍惜的人7758258 发表于 2021-1-7 11:15
12345表格中的01表格。

重新下载26L附件

珍惜的人7758258

yjh_27 发表于 2021-1-7 11:18
重新下载26L附件

马上下。

珍惜的人7758258

yjh_27 发表于 2021-1-7 11:18
重新下载26L附件

非常感谢你的解答，谢谢你，弄好了12345和12345678，请问123456和1234567，可以付费请您弄不？菜鸟的我实在太菜。

yjh_27

珍惜的人7758258 发表于 2021-1-7 11:29
非常感谢你的解答，谢谢你，弄好了12345和12345678，请问123456和1234567，可以付费请您弄不？菜鸟的我实 ...

可以。                  

cui26896

不难，只是当初没有弄懂楼主的意思

珍惜的人7758258

cui26896 发表于 2021-1-7 12:58
不难，只是当初没有弄懂楼主的意思

太难了

lsdongjh

抛弃你所有的公式吧：

1. 
   
2. Sub Test()
   
3.     GetValByStr "12345678", Sheet1, "M", 3, Sheet2, "L", 3, 8
   
4. End Sub
   
5. 
   
6. '从shSource表的strStartCol列第lngStartRowID行开始
   
7. '读取lngCols列的数据
   
8. '按strVal指定的顺序
   
9. '填充到shResult表，从strColID列第lngRowID开始填充
   
10. '**如果lngRows为0，将以strStartCol列的最大非空行为界
    
11. Function GetValByStr(strVal As String, _
    
12.                     shResult As Worksheet, strColID As String, lngRowID As Long, _
    
13.                     shSource As Worksheet, strStartCol As String, lngStartRowID As Long, lngCols As Long, Optional lngRows As Long = 0)
    
14.     Dim arrData As Variant, lngID As Long
    
15.     Dim rgArea As Range, arrID As Variant
    
16.     Dim lngLen As Long, lngTmp As Long
    
17.    
    
18.     strVal = Trim(strVal)
    
19.     If strVal = "" Then
    
20.         MsgBox "输入的顺序为空！"
    
21.         Exit Function
    
22.     End If
    
23.    
    
24.     lngLen = Len(strVal)
    
25.     ReDim arrID(1 To lngLen) As Long
    
26.     '逐个解析顺序串
    
27.     For lngID = 1 To lngLen
    
28.         lngTmp = CLng(Val(Mid(strVal, lngID, 1)))
    
29.         If lngTmp = 0 Or lngTmp > lngCols Then
    
30.             MsgBox "顺序串中的顺序号超过最大列号！"
    
31.             Exit Function
    
32.         Else
    
33.             arrID(lngID) = lngTmp
    
34.         End If
    
35.     Next
    
36.    
    
37.     '如果lngRows为0，读取strStartCol列的最后一行
    
38.     If lngRows = 0 Then
    
39.         lngRows = shSource.Range(strStartCol & Rows.Count).End(xlUp).Row
    
40.     End If
    
41.     If lngRows < lngStartRowID Then
    
42.         MsgBox "源区域有效数据不足！"
    
43.         Exit Function
    
44.     End If
    
45.    
    
46.     Set rgArea = shSource.Range(strStartCol & lngStartRowID & ":" & strStartCol & lngRows)
    
47.    
    
48.     ReDim arrData(1 To lngCols) As Variant
    
49.     For lngID = 1 To lngCols
    
50.         arrData(lngID) = rgArea.Offset(, lngID - 1)
    
51.     Next
    
52.    
    
53.     '清空要填充的区域
    
54.     shResult.Range(strColID & lngRowID).Resize(lngRows, lngLen).ClearContents
    
55.     '按顺序逐列填充
    
56.     For lngID = 1 To lngLen
    
57.         shResult.Range(strColID & lngRowID).Offset(0, lngID - 1).Resize(lngRows, 1) = arrData(arrID(lngID))
    
58.     Next
    
59.    
    
60.     MsgBox "OK"
    
61. End Function
    

复制代码

lsdongjh

抛弃所有公式，支持任意位数，代码审核中，上个附件给你： 任意位数.rar (481.75 KB, 下载次数: 6)

2021-1-7 14:16 上传

点击文件名下载附件

cui26896

lsdongjh 发表于 2021-1-7 14:16
抛弃所有公式，支持任意位数，代码审核中，上个附件给你：

老师能够解释下，要怎样用老师这段代码，怎样输入你的公式，是不是要用数组公式那样三键输入？

cui26896

按自定义公式输入一个单元格，没有反应