洒家 想要 这么 一件 宝物
次宝物 名曰 宝中宝
他 功能 如下
我 三位数 好朋友 ‘111’ 平日 都喜欢 变脸 出门
最近犯愁 变脸 技能 枯燥 想 增添 新技能 焕发一下 精神状态
111 想 换身五位数 大佬 衣裳 穿穿看
衣服 数量 1000件
各路 好汉 请拿出 看家 本领
让的我 111 好朋友 新获得 1000件 新衣裳 行走江湖
在这里 老弟我向 诸位 VBA 大佬 抱拳了

嗯 呐

少侠 你要的1000件衣服到货了 请查收
Sub 宝中宝()
Dim Arr(1 To 100, 1 To 10) As String, Str2 As String, Str3 As String, Count3 As Long, Arr3(1 To 3) As String, Arr5(1 To 5), i As Long, j As Long, k As Long, Row As Long, Column As Long
Str3 = Format(ActiveCell.Value, "000")
If Len(Str3) <> 3 Then Exit Sub
Arr3(1) = Left(Str3, 1)
Arr3(2) = Mid(Str3, 2, 1)
Arr3(3) = Right(Str3, 1)
For i = 1 To 4
For j = i + 1 To 5
Count3 = 1
For k = 1 To 5
Select Case k
Case i, j
Case Else
Arr5(k) = Arr3(Count3)
Count3 = Count3 + 1
End Select
Next k
Row = 1
Column = Column + 1
For k = 0 To 99
Str2 = Format(k, "00")
Arr5(i) = Left(Str2, 1)
Arr5(j) = Right(Str2, 1)
Arr(Row, Column) = Join(Arr5, "")
Row = Row + 1
Next k
Next j
Next i
ActiveCell.Resize(100, 10) = Arr
End Sub

这样？可联系qq47436528

应楼主要求，对下图txt文件里的每一组进行类似的排列

代码已发到你qq上。

赠人玫瑰 手有余香 你若花开 蝴蝶自来

神人 分身 666 666 666

盖楼