Re: [算表] 樞紐分析的問題..(VBA)

看板Office作者windknife18 (windknife18)時間16年前 (2009/07/29 11:56)推噓1(1推 0噓 0→)

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

使用 VBA 來解決 1. Alt+F11 2. 在左邊視窗上, 按滑鼠右鍵->插入->模組 3. 在右邊視窗上, 貼上以下程式碼 4. Alt+Q 5. Alt+F8 選巨集->執行即可 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 Dim flag() As Boolean Dim first As Integer, last As Integer Application.DisplayAlerts = False For i = ThisWorkbook.Sheets.Count To 3 Step -1 ThisWorkbook.Sheets(i).Delete Next i With ThisWorkbook rCount = Sheets(1).Cells(Sheets(1).Rows.Count, 2).End(xlUp).Row ReDim flag(rCount + 1) i = 2 For i = 2 To rCount rangeStr = "1:1" If flag(i) = False Then ' flag(i) = True rangeStr = rangeStr & "," & i & ":" & i For j = i + 1 To rCount first = j If (flag(j) = False) And (Cells(i, 2) = Cells(j, 2)) Then flag(j) = True last = j While last <= rCount And Cells(i, 2) = Cells(last, 2) flag(last) = True last = last + 1 Wend rangeStr = rangeStr & "," & first & ":" & last - 1 j = last - 1 End If Next j .Sheets.Add After:=Sheets(Sheets.Count) .Sheets(Sheets.Count).Name = .Sheets(1).Cells(i, 2) .Sheets(1).Range(rangeStr).EntireRow.Copy Sheets(Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets(Sheets.Count).Range("B:B").Delete Shift:=xlToLeft Sheets(Sheets.Count).Cells(1, 1).Select .Sheets(1).Select End If Next i End With ThisWorkbook.Sheets(1).Select Cells(1, 1).Select Application.CutCopyMode = False MsgBox ("Finish!") End Sub ※ 引述《tunyue (冰鎮紅茶)》之銘言： : 軟體:excel 2003 : 案例為： : 級別｜人名 | 國 | 英 | 數 | : 一級 A 100 100 100 : 一級 B 0 0 0 : 一級 C 50 50 50 : 二級 A 100 100 100 : 二級 B 0 0 0 : 二級 C 50 50 50 : 能不能用樞紐分析或是哪種方法..可以迅速排列組合成： : 分頁=>A : 級別 | 國 | 英 | 數 | : 一級 100 100 100 : 二級 100 100 100 : 分頁=>B : 級別 | 國 | 英 | 數 | : 一級 0 0 0 : 二級 0 0 0 : 分頁=>C : 級別 | 國 | 英 | 數 | : 一級 50 50 50 : 二級 50 50 50 : 弄成這種類似組合... : 樞紐分析弄了老半天還是弄不出來..只好上來問看看了..=.="... -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 61.229.79.171