Re: [算表] 將特定條件的儲存格輸出成多個檔案--VBA

看板Office作者 (Joyce)時間14年前 (2009/11/06 12:05), 編輯推噓2(204)
留言6則, 2人參與, 最新討論串11/12 (看更多)
抱歉,感謝windknife18大大提醒前面有做過此法的說明 但實際操作時候仍發生問題 .Sheets(Sheets.Count).Name = .Sheets(1).Cells(i, 1) 出現了error,→應用程式或物件定義上的錯誤 還是2003跟2007有些微的不同? 麻煩了..真不好意思>"< ※ 引述《windknife18 (windknife18)》之銘言: : 看看是不是你想要的囉 .... : Option Explicit : Sub Macro1() : Dim i As Integer, j As Integer, rCount As Integer : Dim firstr As Integer, lastr As Integer : Dim rangeStr As String : '不要問要不要覆蓋檔案 : Application.DisplayAlerts = False : '先清掉其他 sheets : For i = ThisWorkbook.Sheets.Count To 2 Step -1 : ThisWorkbook.Sheets(i).Delete : Next i : With ThisWorkbook : '計算多少筆資料 : rCount = Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row : i = 2 : While i <= rCount '處理每一筆資料 : j = i + 1 : rangeStr = "1:1" : '找出相同的資料 : While (Sheets(1).Cells(j, 1) = Sheets(1).Cells(i, 1)) _ : And (j <= rCount) : j = j + 1 : Wend : If (j = rCount + 1) Then : rangeStr = rangeStr & "," & i & ":" & j : Else : rangeStr = rangeStr & "," & i & ":" & (j - 1) : End If : .Sheets.Add After:=Sheets(Sheets.Count) : .Sheets(Sheets.Count).Name = .Sheets(1).Cells(i, 1) : .Sheets(1).Range(rangeStr).EntireRow.Copy _ : Destination:=Sheets(Sheets.Count).Range("A1") : i = j : Wend : End With : MsgBox ("成功") : End Sub : ※ 引述《wengho (wengho)》之銘言: : : 請教一個延伸問題 : : 譬如這個檔案 : : 已經做過排序 : : 如下: : : 科別 機構 A科目 B科目 C科目 ........ : : 一科 A : : 一科 F : : 二科 C : : 南辦 H : : 這一回所輸出的資料是同一個檔案 "更改sheet工作表名稱" 並把資料COPY分類置個科別 : : 如:總表.XLS : : 總表 一科 二科 南辦 … : : 點選"一科"工作表 : : 內容就變成 : : 科別 機構 A科目 B科目 C科目 ........ : : 一科 A : : 一科 B --  想要過好日子要先好好過日子  這麼簡單的道理 你做的到嗎 -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 60.198.6.140

11/06 12:15, , 1F
11/06 12:15, 1F

11/06 12:48, , 2F
謝謝您的檔案,可以跑成功,但資料置入我的內容,就掛
11/06 12:48, 2F

11/06 12:48, , 3F
了,我會再好好仔細研讀一下..謝謝您熱心幫助^^
11/06 12:48, 3F

11/06 13:32, , 4F
看了一下,應該是之前的範例,資料是排序好的,
11/06 13:32, 4F

11/06 13:32, , 5F
我有修改過了,加了排序功能,看看適不適合囉 ...
11/06 13:32, 5F

11/06 13:33, , 6F
文章代碼(AID): #1Ayw2VLX (Office)
討論串 (同標題文章)
本文引述了以下文章的的內容:
完整討論串 (本文為第 11 之 12 篇):
文章代碼(AID): #1Ayw2VLX (Office)