程式菜鳥 ![]() | 【求助】excel-vba資料依需求重新排列??? 檔案原始呈現畫面 ![]() 資料需如圖重新排列 ![]() 資料大約有4000行左右,請教各位前輩小弟應該如何撰寫這個vba程式?? |
回覆 |
Take it easy~ | 其實手動操作也還好,不會花太多時間... 以下先試試看吧~ 語法: Sub Macro1() Set firstCell = [A21] lastCol = 24 'X欄 lastRow = [I65536].End(xlUp).Row With Range(firstCell, Cells(lastRow, lastCol)) .Columns(1).NumberFormat = "@" .Replace " ", "", LookAt:=xlPart .MergeCells = False .Sort firstCell, xlAscending, Header:=xlNo, _ OrderCustom:=1, Orientation:=xlTopToBottom End With firstRow = firstCell.Row lastRow = [M65536].End(xlUp).Row With Range(firstCell, Cells(lastRow, lastCol)) .Columns.AutoFit .Rows.AutoFit For c = lastCol To 2 Step -1 If (lastRow - firstRow) < WorksheetFunction. _ CountBlank(.Columns(c)) Then Columns(c).Delete End If Next c .Cells(1).Select End With End Sub |
回覆 |
程式菜鳥 ![]() | 謝謝 leonchou 兄幫忙!感恩 先前參考 leonchou 兄http://www.pczone.com.tw/vbb3/showthread.php?t=140422 所撰寫的vba程式可是都看不懂,我想我這位程式幼教班的學生可要多多向這裡的前輩學習 小弟先前參考 leonchou 兄所撰寫的vba程式修改如下: Sub summary() Dim r&, sh As Worksheet r = 5: On Error Resume Next For Each sh In Worksheets If sh.Name <> "summary" Then If Cells(r, 1).Borders(xlEdgeBottom).LineStyle = xlDouble Then Cells(r, 1).Resize(, 12).Insert Shift:=xlShiftDown Cells(r, 1).Resize(, 12).FillDown End If For r1 = 5 To sh.[a65536].End(xlUp).Row Cells(r, 1) = sh.Cells(r1, 1) Cells(r, 2) = sh.Cells(r1, 2) Cells(r, 3) = sh.Cells(r1, 3) Cells(r, 7) = sh.Cells(r1, 10) Cells(r, 9) = sh.Cells(r1, 11) Cells(r, 3).MergeArea.UnMerge Cells(r, 7).MergeArea.UnMerge Cells(r, 9).MergeArea.UnMerge Cells(r, 11).MergeArea.UnMerge r = r + 1 Next r1 End If Next sh Range([A19], Cells(r - 1, 12)).Sort [B19], Key2:=[A19], Header:=xlNo '恢復合併 For r = 5 To [a65536].End(xlUp).Row Cells(r, 3).Resize(, 4).Merge Cells(r, 7).Resize(, 2).Merge Cells(r, 9).Resize(, 2).Merge Cells(r, 11).Resize(, 2).Merge Next r Set sh = Nothing End Sub 執行結果如下: 101000000 合約界面協調 101000000 合約界面協調 102000000 管線設施協調 102000000 管線設施協調 102010000 管線工程師 102010000 管線工程師 103000000 測量及放樣人員 103000000 測量及放樣人員 請問為何同一列資料會有兩列出現....(不解中) 問題1:想請問前輩可否告知這二個程式是如何運作??? 問題2:程式初學者應該涉獵哪些書籍?? 謝謝各位前輩指教 |
回覆 |
Take it easy~ | 引用:
我上面寫的程式你試過了嗎? 哪裡不符合需求? 來解釋一下程式,你看看吧: Sub Macro1() Set firstCell = [A21] '設變數firstCell=處理範圍第一格 lastCol = 24 '設變數lastCol=處理範圍最後一欄的欄號(X欄) lastRow = [I65536].End(xlUp).Row '設變數lastRow=處理範圍最後一筆的列號 With Range(firstCell, Cells(lastRow, lastCol)) '對處理範圍進行以下動作 .Columns(1).NumberFormat = "@" '第一欄(項目代號)設為文字格式,以便對齊 .Replace " ", "", LookAt:=xlPart '移除空格 .MergeCells = False '取消合併儲存格 .Sort firstCell, xlAscending, Header:=xlNo, _ OrderCustom:=1, Orientation:=xlTopToBottom '依項目代號排序 End With firstRow = firstCell.Row '設變數firstRow=firstCell的列號 lastRow = [M65536].End(xlUp).Row '設變數lastRow=排序後處理範圍最後一筆的列號 With Range(firstCell, Cells(lastRow, lastCol)) '對排序後的處理範圍進行以下動作 .Columns.AutoFit '設定為最適欄寬 .Rows.AutoFit '設定為最適列高 For c = lastCol To 2 Step -1 '進行迴圈: 逐欄判斷 If (lastRow - firstRow) < WorksheetFunction. _ CountBlank(.Columns(c)) Then '如果該欄是空白 Columns(c).Delete '則刪除該欄 End If Next c .Cells(1).Select '最後選取第一格,結束 End With End Sub 註: 這個程式只有處理原始資料的工作表,目的是先讓你看看處理結果可不可以。 有需要再決定是手動或自動轉入第二張工作表。 引用:
只知道這裡有口碑不錯的Excel書,還有一些書評 -- http://www.excelhelp.net/bookreview/mybook2.htm http://www.excelhelp.net/cgi-bin/fo...ums.cgi?forum=7 還有最近看到的 -- http://gb.twbts.com/index.php/topic,1883.0.html 其實個人覺得,要學好VBA,書本不是唯一的方法。 重點是多看多做多嘗試,從經驗中學習。 我不否認看書可以學到一些概念,但程式本身的語法說明就不盡然了。VBA線上說明是我主要的學習途徑,我的方法是以錄製巨集開始,看看它產生的程式是怎麼寫的。看程式或寫程式的時候,想要查閱說明,只要滑鼠點在想查的字上,然後按 F1 即可。VBA說明中包含程式語法、說明和範例,看多了自然就知道怎麼寫了。 這是我的方式,不一定適合你 -- 僅提供參考。 關於學習 VBA,可參考相關討論、我的經驗分享 -- http://www.pczone.com.tw/vbb3/showthread.php?t=62955 http://www.pczone.com.tw/vbb3/showthread.php?t=61219 | ||
回覆 |
程式菜鳥 ![]() | 最近忙翻了忘了回報使用狀況,希望 leonchou 兄原諒! 首先再次感謝 leonchou 兄幫忙!感恩(因為短短的幾行程式可以節省許多人力再核對資料方面) 回報使用情況: 問題1: 第一欄(項目代號)有9碼-10碼,(排列順序0123456789ABC...依序) 程式執行後會有一些(項目代號)順序錯置,如 (希望排列順序) (程式執行結果) 109020000 109020000 109030000 109020000 109040000 109020000 10A000000 200000000 10B000000 201000000 200000000 10A000000 201000000 10B000000 問題2: 第一欄(項目代號)如30E000000,40E000000,60E000000....等數值經過程式轉換成文字後會變成科學符號,3.00E+01,4.00E+01,6.00E+01 |
回覆 |
Take it easy~ | 只加了一句,測試階段只貼部份程式碼以免佔篇幅。 你再試試看吧。 Sub Macro1() ...... ...... With Range(firstCell, Cells(lastRow, lastCol)) .Columns(1).NumberFormat = "@" '項目代號空格換為單引號以排序且防止變成科學符號 .Columns(1).Replace " ", "'", LookAt:=xlPart .Replace " ", "", LookAt:=xlPart '移除空格 ...... ...... End With ...... ...... ...... End Sub |
回覆 |
會員 ![]() | 這個巨集程式蠻有意思的, 雖然leonchou兄說明的很清楚(綠色字), 但是我還是不太懂,我有照表操練試了一下還真是方便, 那些指令OFFICE小幫手裡應該都會有說明吧。 |
回覆 |
|
![]() | ||||
主題 | 主題作者 | 討論版 | 回覆 | 最後發表 |
【求助】Excel 不同工作表之間的資料整合 | ja0206 | -- OFFICE 相 關 軟 體 討 論 版 | 4 | 2005-05-06 09:12 AM |
【求助】Excel 要如何自動加減 | camel | -- OFFICE 相 關 軟 體 討 論 版 | 13 | 2005-01-09 03:47 PM |
【求助】Excel 座標轉換 | ulimie | -- OFFICE 相 關 軟 體 討 論 版 | 4 | 2004-12-24 03:53 PM |
【求助】EXCEL | lung6660 | -- OFFICE 相 關 軟 體 討 論 版 | 2 | 2002-05-05 08:57 PM |
【求助】EXCEL 亂數 | Peter H. | -- OFFICE 相 關 軟 體 討 論 版 | 3 | 2002-03-05 12:41 PM |
XML | RSS 2.0 | RSS |
本論壇所有文章僅代表留言者個人意見,並不代表本站之立場,討論區以「即時留言」方式運作,故無法完全監察所有即時留言,若您發現文章可能有異議,請 email :[email protected] 處理。