ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 我的酷贴 > Excel VBA > 如何用VBA把A列的办事处类别款号分列?

如何用VBA把A列的办事处类别款号分列?

作者:绿色风 分类: 时间:2022-08-18 浏览:148
楼主
herelazy
Q:如何用VBA把A列的办事处,类别,款号分列?
如图所示:

 
A:
  1. Sub test()
  2. Dim N&, Rng As Range, Rng2 As Range
  3. Application.ScreenUpdating = False
  4. For N = 34 To Cells(Rows.Count, 1).End(3).Row
  5.     If Cells(N, 1) <> "" Then
  6.         If Cells(N, 1).Value Like "*办" Then
  7.             If Not Rng Is Nothing Then
  8.                 With Rng
  9.                     .Offset(1) = .Value
  10.                     Range(.Offset(1), Cells(N - 1, 1)).Merge
  11.                 End With
  12.             End If
  13.             Set Rng = Cells(N, 1)
  14.             If Not Rng2 Is Nothing Then
  15.                 With Rng2
  16.                     .Offset(, 1).Resize(1, 6).Cut
  17.                     Cells(N, 3).Insert
  18.                     Range(Rng2, Cells(N - 1, Rng2.Column)).Merge
  19.                     Set Rng2 = Nothing
  20.                 End With
  21.             End If
  22.         ElseIf Cells(N, 1).Value Like "[0-9A-Z]*" Then
  23.             With Cells(N, 1)
  24.                 .Offset(, 2) = .Value
  25.                 .Value = ""
  26.             End With
  27.         ElseIf Cells(N, 1).Value = "总计" Then
  28.             If Not Rng2 Is Nothing Then
  29.                 With Rng2
  30.                     .Offset(, 1).Resize(1, 6).Cut
  31.                     Cells(N, 3).Insert
  32.                     Range(Rng2, Cells(N - 1, Rng2.Column)).Merge
  33.                 End With
  34.             End If
  35.             If Not Rng Is Nothing Then
  36.                 With Rng
  37.                     .Offset(1) = .Value
  38.                     Range(.Offset(1), Cells(N - 1, 1)).Merge
  39.                 End With
  40.             End If
  41.             Cells(N, 1).Resize(1, 3).Merge
  42.         Else
  43.             If Not Rng2 Is Nothing Then
  44.                 With Rng2
  45.                     .Offset(, 1).Resize(1, 6).Cut
  46.                     Cells(N, 3).Insert
  47.                     Range(Rng2, Cells(N - 1, Rng2.Column)).Merge
  48.                 End With
  49.             End If
  50.             With Cells(N, 1)
  51.                 .Offset(, 1) = .Value
  52.                 .Value = ""
  53.                 .Offset(, 2) = "合计"
  54.                 Set Rng2 = .Offset(, 1)
  55.             End With
  56.         End If
  57.     End If
  58. Next N
  59. [c1].Resize(N - 2, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  60. Application.ScreenUpdating = True
  61. End Sub

分列重排.rar
2楼
成就滋味
这个太实用了,必须珍藏

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap