[已解决]表格格式转换

dyzx

请各位老师帮忙将初一级、初二级、初三级这三个工作表转换成样式工作表格式，多谢。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-27 05:05

权当练练手，有代码调试的功夫，手工也做好了

跳转到最佳答案楼层

su45

一次性的

dyzx

su45 发表于 2014-10-26 20:35
一次性的

su45老师：一次性的和单个有什么不同，分开做可以吗？多谢

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%, k&, k2&, zf$
   
3. '用正则表达式把1-3转变为1、2、3，然后用字典比对
   
4. Set d = CreateObject("scripting.dictionary")
   
5. Sheets("样式").Activate
   
6. brr = Range("a1").CurrentRegion
   
7. ReDim crr(1 To UBound(brr) - 3, 1 To UBound(brr, 2) - 2)
   
8. With CreateObject("vbscript.regexp")
   
9.     .Pattern = "\d+\—\d+"
   
10.     .Global = True
    
11. For j = 1 To 3 '循环前3个工作表
    
12.     n = Sheets(j).Cells.Find("*", SearchDirection:=xlPrevious).Row '最后行
    
13.     arr = Sheets(j).Range("a1:g" & n)
    
14.     gzb = Left(Sheets(j).Name, 2) '工作表名称前2个字符
    
15.     For i = 3 To UBound(arr)
    
16.         For m = 2 To 6 Step 4
    
17.             If arr(i, m) <> "" And arr(i, m - 1) = "" Then arr(i, m - 1) = arr(i - 1, m - 1)
    
18.             Set ms = .Execute(arr(i, m + 1))
    
19.             If ms.Count > 0 Then
    
20.                 x = Split(ms(0), "—"): p = ""
    
21.                 For k = x(0) To x(UBound(x))
    
22.                     p = p & "、" & k
    
23.                 Next
    
24.                 arr(i, m + 1) = Replace(arr(i, m + 1), ms(0), Mid(p, 2))
    
25.             End If
    
26.             y = Split(arr(i, m + 1), "、")
    
27.             For k2 = 0 To UBound(y)
    
28.                 zf = y(k2) & "," & gzb & "," & arr(i, m - 1)
    
29.                 d(zf) = arr(i, m)
    
30.             Next
    
31.         Next
    
32.     Next
    
33. Next
    
34. End With
    
35. For i = 4 To UBound(brr)
    
36.     If brr(i, 1) = "" Then brr(i, 1) = brr(i - 1, 1)
    
37.     zf = brr(i, 2) & "," & brr(i, 1)
    
38.     For j = 3 To UBound(brr, 2)
    
39.         crr(i - 3, j - 2) = d(zf & "," & brr(3, j))
    
40.     Next
    
41. Next
    
42. Range("c4").Resize(UBound(crr), UBound(crr, 2)) = crr
    
43. End Sub

复制代码

dsmch

权当练练手，有代码调试的功夫，手工也做好了

dyzx

dsmch 发表于 2014-10-27 05:05
权当练练手，有代码调试的功夫，手工也做好了

dsmch老师：非常多谢你的帮助。