Board logo

標題: [發問] 請問是否可以用儲存格的資料來排序工作表 [打印本頁]
作者: luffyzoro    時間: 2011-11-29 15:36     標題: 請問是否可以用儲存格的資料來排序工作表

本帖最後由 luffyzoro 於 2011-11-29 15:42 編輯

各位高手
不好意思,又要來請教

假設A檔案中有多個工作表,但其格式都一樣
如果要用每個工作表的B2儲存格替工作表排序
B2儲存格是數值
工作表則由B2儲存格的大小,由左到右依序為由小到大

請問是否可能完成
作者: GBKEE    時間: 2011-11-29 16:01

回復 1# luffyzoro
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet
  4.     For Each Sh In Sheets
  5.         Sh.Move Sheets(Sh.[b2])
  6.     Next
  7. End Sub
複製代碼
作者: luffyzoro    時間: 2011-11-29 16:30

回復 2# GBKEE


版大您好,

Sh.Move Sheets(Sh.[b2])執行到這一行時出現  執行階段錯誤"13" 型態不符
請教版大
Sh.Move Sheets(Sh.[b2])這行的意思是? Sheets(sh.[b2])是指worksheets中的每一sheet的儲存格b2嗎?

感謝版大的迅速回覆
作者: Hsieh    時間: 2011-11-29 16:35

回復 3# luffyzoro
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")

  5. For Each sh In Sheets
  6.   k = k + 1
  7.   d(k) = sh.[B2].Value
  8.   d1(k) = sh.Name
  9. Next
  10. Do Until d.Count = 0
  11. ar = d.items: ay = d.keys
  12.   n = Application.Match(Application.Min(ar), ar, 0) - 1
  13.   ky = ay(n)
  14.   d.Remove ky
  15.   Sheets(d1(ky)).Move after:=Sheets(Sheets.Count)
  16. Loop
  17. End Sub
複製代碼
作者: GBKEE    時間: 2011-11-29 16:47

回復 3# luffyzoro
Sh.Move Sheets(Sh.[b2])執行到這一行時出現  執行階段錯誤"13" 型態不符
[b2]  須是數字  >0 且 < =Sheets.Count(工作表的總數)  

For Each Sh In Sheets                     -> 在 Sheets工作表集合(物件) ,  依序處裡 Sh(工作表).
       Sh.Move Sheets(Sh.[b2])        ->Sh(這工作表) 的[b2]
作者: luffyzoro    時間: 2011-11-29 16:55

本帖最後由 luffyzoro 於 2011-11-29 17:04 編輯

回復 4# Hsieh


版大您好,

雖然您寫的我幾乎看不懂.......
但是程式試run的結果是ok的.......因為我將儲存格內容改為數字
才發現我的提問是錯的
請問如果儲存格b2的內容若是   '0753333   這種格式的話
需要如何做修改
抱歉,連問題都寫的不清楚

謝謝
作者: luffyzoro    時間: 2011-11-29 16:57

回復 5# GBKEE


是的,版大

我發現儲存格是   '0753333  這種資料

真是抱歉,問題都問的不清楚
作者: Hsieh    時間: 2011-11-29 17:48

本帖最後由 Hsieh 於 2011-11-29 20:33 編輯

回復 6# luffyzoro
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件
  3. Set d1 = CreateObject("Scripting.Dictionary")  '創建字典物件

  5. For Each sh In Sheets  '以所有工作表做迴圈
  6.   k = k + 1  '設置變數k，每一個工作表增加變數值1
  7.   d(k) = Val(sh.[B2].Value)  '將工作表B2的值存入字典物件
  8.   d1(k) = sh.Name   '將工作表名稱存入字典物件
  9. Next
  10. Do Until d.Count = 0  '執行迴圈，直到字典物件內沒有項目存在
  11. ar = d.items: ay = d.keys  '將字典物件的索引值及內容取出指定給陣列變數
  12.   n = Application.Match(Application.Min(ar), ar, 0) - 1  '找到最小值的序號，因陣列的索引值是從0開始，所以必須將位置減1，才是對照的索引值
  13.   ky = ay(n)  'ky會得到目前字典物件內容(B2值)的最小值對應的工作表名稱
  14.   d.Remove ky  '移除字典項目
  15.   Sheets(d1(ky)).Move after:=Sheets(Sheets.Count)  '將工作表移動到最後
  16. Loop
  17. End Sub
複製代碼
作者: GBKEE    時間: 2011-11-29 20:13

回復 7# luffyzoro
  1. Sub Ex()
  2.     Dim AR(), AR1(), i As Integer, N As Integer, Sh As Worksheet
  3.     ReDim AR(1 To Sheets.Count)                             '設定陣列維數( 1 to 工作表總數)
  4.     ReDim AR1(1 To Sheets.Count)                            '設定陣列維數( 1 to 工作表總數)
  5.     For i = 1 To Sheets.Count
  6.         AR(i) = Val(Sheets(i).[b2])                         'Sheets(i).[b2]數字置入陣列中
  7.     Next
  8.     For i = 1 To Sheets.Count
  9.         AR1(i) = Application.WorksheetFunction.Small(AR, i) '陣列排序由小到大
  10.     Next
  11.     For Each Sh In Sheets
  12.         N = Application.Match(Val(Sh.[b2]), AR1, 0)         '取得 Sh.[b2] 數值於AR1陣列中排序的位置
  13.         Sh.Move Sheets(N)                                   '移動Sh於Sheets(N)之前
  14.     Next
  15. End Sub
複製代碼
作者: luffyzoro    時間: 2011-11-30 10:48

回復 8# Hsieh


Dim sCount%, i%, j%
      sCount = Worksheets.Count
        If sCount = 1 Then Exit Sub
        For i = 1 To sCount - 1
          For j = i + 1 To sCount
             If Worksheets(j).Range("b2").Value < Worksheets(i).Range("b2") Then
                 Worksheets(j).Move before:=Worksheets(i)
             End If
          Next
        Next
請問版大這樣寫與您寫的是否有差異?
作者: luffyzoro    時間: 2011-11-30 10:49

回復 9# GBKEE


Dim sCount%, i%, j%
       sCount = Worksheets.Count
        If sCount = 1 Then Exit Sub
        For i = 1 To sCount - 1
          For j = i + 1 To sCount
             If Worksheets(j).Range("b2").Value < Worksheets(i).Range("b2") Then
                 Worksheets(j).Move before:=Worksheets(i)
             End If
          Next
        Next
請問版大這樣寫與您寫的是否有差異?
作者: GBKEE    時間: 2011-11-30 11:11

回復 12# luffyzoro
很棒ㄚ, 這就是你要的效果.條條大路通羅馬的,



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)