工作需要，求助大神帮忙修改一下VBA代码，谢谢

wzsy2_mrf

烟火孤星泪 发表于 2019-3-15 09:05
不用了，已经解决了，谢谢各位

解决了，那就分享一下吧，上论坛总不能只要不给。

烟火孤星泪

wzsy2_mrf 发表于 2019-3-15 09:24
解决了，那就分享一下吧，上论坛总不能只要不给。

1. Sub 生成效果表③()
   
2. 'Date:2019/3/7 二月初一 Thursday
   
3. '标签:word,excel数据导入word
   
4. '备注1:
   
5. Application.DisplayAlerts = False
   
6. ActiveWorkbook.Save
   
7. Application.DisplayAlerts = True
   
8. Dim arr2(1 To 50 ^ 4, 1 To 2), rng As Range
   
9. arr = ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion
   
10. For i = 3 To UBound(arr)
    
11. If Len(arr(i, 1)) Then
    
12. k = k + 2
    
13. arr2(k, 1) = arr(i, 1)
    
14. End If
    
15. k = k + 1
    
16. arr2(k, 1) = arr(i, 2)
    
17. arr2(k, 2) = arr(i, 3)
    
18. Next
    
19. Application.DisplayAlerts = False
    
20. On Error Resume Next
    
21. ActiveWorkbook.Worksheets("效果表").Delete
    
22. On Error GoTo 0
    
23. With ActiveWorkbook.Worksheets.Add
    
24. .Name = "效果表"
    
25. Columns("a:a").ColumnWidth = 25
    
26. Columns("b:b").ColumnWidth = 70
    
27. [b:b].WrapText = True
    
28. With .Range("A1").Resize(k, 2)
    
29. .Value = arr2
    
30. .EntireColumn.AutoFit
    
31. For Each rng In .Resize(k, 1).SpecialCells(xlCellTypeBlanks)
    
32. With rng.Offset(1).Resize(1, 2)
    
33. .Merge
    
34. .HorizontalAlignment = xlCenter
    
35. .VerticalAlignment = xlCenter
    
36. .Font.Bold = True
    
37. .Font.ColorIndex = 3
    
38. .Font.Name = "等线"
    
39. .Font.Size = 16
    
40. End With
    
41. Next
    
42. End With
    
43. .Range("A1").EntireRow.Delete
    
44. .Range("A1").Resize(k - 1, 2).Copy
    
45. End With
    
46. Columns("a:a").ColumnWidth = 19
    
47. Columns("b:b").ColumnWidth = 68
    
48. With CreateObject("Word.Application")
    
49. Set Doc = .Documents.Add
    
50. Doc.Content.PasteExcelTable False, False, False
    
51. Doc.SaveAs2 ActiveWorkbook.Path & "\效果.docx"
    
52. Doc.Close True
    
53. .Quit
    
54. End With
    
55. Set Doc = Nothing
    
56. Application.DisplayAlerts = True
    
57. MsgBox "完成"
    
58. End Sub
    

复制代码