[已解决]数据按要求重新排列

HNZZHGY

HNZZHGY 发表于 2016-3-21 14:21
老师我再问一下如果原始数据起始在不同的行列，比如在单元格K11起始时如何修改？

老师，只在附件达到要求，如果原始数据换行列就不行了，还有原始数据前还必须是空列或A列才行，

HNZZHGY

HNZZHGY 发表于 2016-3-21 14:21
老师我再问一下如果原始数据起始在不同的行列，比如在单元格K11起始时如何修改？

原来是对原始数据有要求，如果修改成任意的原始数据都行？谢谢老师！

HNZZHGY

dsmch 发表于 2016-3-21 13:35
原数据模拟有误，与效果不符

老师，看到我上传的付件没有，还要麻烦你再看一下，谢谢了！

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("t10:t" & Range("t65536").End(xlUp).Row)
   
5. ReDim brr(1 To UBound(arr) - 1, 1 To 1)
   
6. For i = 2 To UBound(arr)
   
7.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
   
8. Next
   
9. For i = 2 To UBound(arr)
   
10.     sj = arr(i, 1)
    
11.     If sj <> "" And d.exists(sj) Then
    
12.         x = Split(Mid(d(sj), 2), ",")
    
13.         For j = 0 To UBound(x)
    
14.             s = s + 1
    
15.             brr(s, 1) = sj
    
16.             arr(x(j), 1) = ""
    
17.         Next
    
18.         If InStr(sj, "-") Then
    
19.             y = Split(sj, "-")
    
20.             zf = y(1) & "-" & y(0)
    
21.         Else
    
22.             With CreateObject("vbscript.regexp")
    
23.                 .Global = True
    
24.                 .Pattern = "[A-Z]\d*"
    
25.                 Set m = .Execute(sj): zf = ""
    
26.                 For j = m.Count - 1 To 0 Step -1
    
27.                     zf = zf & m(j)
    
28.                 Next
    
29.             End With
    
30.         End If
    
31.         If d.exists(zf) Then
    
32.             y = Split(Mid(d(zf), 2), ",")
    
33.             For j = 0 To UBound(y)
    
34.                 s = s + 1
    
35.                 brr(s, 1) = zf
    
36.                 arr(y(j), 1) = ""
    
37.             Next
    
38.         End If
    
39.     End If
    
40. Next
    
41. Range("v11").Resize(UBound(brr)) = brr
    
42. End Sub

复制代码

HNZZHGY

已经解决，谢谢dsmch老师！