作者nash30113 (生活艺术家)
看板Office
标题[算表] VBA如何依分类插入空白列
时间Fri May 18 23:52:01 2018
软体:Excel
版本:2007/2010
我的工作表如下：
日期 客单编号
================
5/18 A
5/18 A
5/18 B
5/18 B
5/18 B
5/18 C ←我想依客单编号後面加入空白列
5/18 C
希望能变成：
日期 客单编号
================
5/18 A
5/18 A
(空白列)
5/18 B
5/18 B
5/18 B
(空白列)
5/18 C
5/18 C
(空白列)
经查网路VBA模组可以让每一列插入空白列
但我需要的是依分类去插入空白
不知道程式码该怎麽修改
再请版上大大指导一下
感谢!
档案如下：
https://goo.gl/ihCTvB
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 114.24.153.3
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1526658726.A.BBF.html
1F：→ newton41: For rN = endRow to startRow+1 step -1 05/19 00:02
2F：→ newton41: If cells(rN,2)<>cells(rN-1,2) then rows(rN).inse 05/19 00:02
3F：→ newton41: rt 05/19 00:02
4F：→ newton41: Next 05/19 00:02
5F：→ newton41: 大概类似这样，从下面跑回去就比较不会被插入列影响到。 05/19 00:04
6F：→ newton41: 你的档案我没看，可以的话贴到文章吧。 05/19 00:04
原程式码如下，不知道改怎麽修改？
Dim IntCount As Integer
IntCount = Application.WorksheetFunction.CountA(Range("A:A")) - 1
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "temp"
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Stop:=IntCount, Trend:=False
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("工作表1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("工作表1").Sort.SortFields.Add
Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("工作表1").Sort
.SetRange ActiveCell.Range("A2:N" & (IntCount * 2))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Select
※ 编辑: nash30113 (114.24.153.3), 05/19/2018 00:10:10
8F：→ nash30113: 感谢S大，原来可以改成这麽简洁!! 05/19 00:11
9F：→ newton41: 听s大的错不了。 05/19 00:12
10F：→ nash30113: n大也感谢你的协助! 05/19 00:14
11F：→ soyoso: 如要以原巨集码的逻辑的话 05/19 00:39
13F：→ soyoso: 则保留 05/19 00:40
14F：→ nash30113: 非常感谢S大的协助!! 05/19 12:13