作者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/m.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