- 帖子
- 75
- 主題
- 8
- 精華
- 0
- 積分
- 109
- 點名
- 0
- 作業系統
- windows XP
- 軟體版本
- office 2010
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 高雄
- 註冊時間
- 2015-4-19
- 最後登錄
- 2024-8-10
|
2#
發表於 2019-5-19 10:02
| 只看該作者
回復 1# peter631114
Sub 更新_20190519()
ROW1 = Cells(Rows.Count, "C").End(3).Row
Range("C2").Select
'排序===============================================================
ActiveWorkbook.Worksheets("資料").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("C2:C" & ROW1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("L2:L" & ROW1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("資料").Sort
.SetRange Range("A1:M" & ROW1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets(1).Copy after:=Sheets(Sheets.Count)
Range("A2:M" & ROW1).ClearContents
k = ActiveCell.Row
Sheets(1).Select
For i = 2 To ROW1
If Cells(i, "C") = Cells(i + 1, "C") And Cells(i, "L") = Cells(i + 1, "L") Then
Range(Cells(i, "A"), Cells(i + 1, "M")).Copy Sheets(Sheets.Count).Cells(k, "A")
k = k + 2
End If
Next
End Sub
 Data.zip (32.59 KB)
|
|
