Re: [算表] 抓出重覆資料，集中並排序(VBA)

看板Office作者windknife18 (windknife18)時間17年前 (2009/06/23 18:12)推噓1(1推 0噓 0→)

留言1則, 1人參與討論串1/1

以下是 VBA 程式，使用方法請參考晶華區或以前的文章 Option Explicit Sub Macro1() Dim rCount As Integer Dim curdir As String Dim i As Integer, j As Integer Dim wbNew As Workbook Dim flag() As Boolean Dim rangeStr As String Dim count As Integer '不要問要不要覆蓋檔案 Application.DisplayAlerts = False Application.ScreenUpdating = False curdir = ThisWorkbook.Path & Application.PathSeparator With ThisWorkbook.Sheets(1) '計算多少筆資料 rCount = .Cells(.Rows.count, 1).End(xlUp).Row ReDim flag(rCount) For i = 1 To rCount rangeStr = "" If flag(i) = False Then '檢查是否有處理過 flag(i) = True rangeStr = i & ":" & i count = 1 For j = i + 1 To rCount '將相同名稱的串起來 If (flag(j) = False) And (Cells(i, 2) = Cells(j, 2)) Then rangeStr = rangeStr & "," & j & ":" & j flag(j) = True count = count + 1 End If Next j If count > 1 Then Set wbNew = Workbooks.Add .Range(rangeStr).EntireRow.Copy wbNew.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False wbNew.Sheets(1).Cells(1, 1).Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlStroke, DataOption1:=xlSortTextAsNumbers wbNew.Close SaveChanges:=True, Filename:=curdir & .Cells(i, 2) & ".xls" End If End If Next i End With Sheets(1).Select Cells(1, 1).Select Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox ("完成") End Sub ※ 引述《cmoeoo (呆呆向前衝)》之銘言： : 軟體:EXCEL : 版本:2003 : 資料表示如下~ : A B C D.......... : 1 983 王聰明 A1234567 3322554 高雄市左營區… : 2 974 林小美 B2229876 3457788 高雄市楠梓區… : 3 988 張小華 C1235546 3215545 高雄市三民區… : 4 1002 林小美 B2229876 3457788 高雄市楠梓區… : 5 1045 王聰明 A1234567 3322554 高雄市左營區… : 6 2300 孫小晶 B2225674 2345567 台中市中區… : 7 3564 孫小晶 B2225674 2345567 台中市中區… : 8 4302 林小美 B2229876 3457788 高雄市楠梓區… : 9 5100 王聰明 A1234567 3322554 高雄市左營區… : . : . : . : . : 這樣的資料總共有2千多筆 : 想「只把有重覆的資料抓出來」例如王聰明有3筆，3筆都要抓 : 變成另一個檔案，並依順序以A欄排序，整理後想變成： : A B C D.......... : 1 983 王聰明 A1234567 3322554 高雄市左營區… : 5 1045 王聰明 A1234567 3322554 高雄市左營區… : 9 5100 王聰明 A1234567 3322554 高雄市左營區… : 2 974 林小美 B2229876 3457788 高雄市楠梓區… : 4 1002 林小美 B2229876 3457788 高雄市楠梓區… : 8 4302 林小美 B2229876 3457788 高雄市楠梓區… : 6 2300 孫小晶 B2225674 2345567 台中市中區… : 7 3564 孫小晶 B2225674 2345567 台中市中區… : 請問有辦法嗎?\拜託各位高手教教我~~~跪求QQ -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 140.131.84.79