Board logo

標題: [發問] COLUMN問題 [打印本頁]
作者: basarasy    時間: 2011-4-1 22:43     標題: COLUMN問題

請問大大2個問題.

第1個是圖片中的問題.

第2個是 如果想DEL  COLUMN("A:A")  可以把 A:A轉用數字嗎? COLUMN("1:1").DEL

[attach]5209[/attach]
作者: Hsieh    時間: 2011-4-2 23:35

回復 1# basarasy
猜想是這樣的意思
  1. Sub Ex()
  2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
  3. Set Rng = [A1:G1]
  4. For Each A In Rng
  5.    If A = Application.Max(Rng) Then
  6.       ReDim Preserve Ar(s)
  7.       ReDim Preserve Ay(s)
  8.       Ar(s) = A.Address
  9.       Ay(s) = A.Column
  10.       s = s + 1
  11.    End If
  12. Next
  13. [H1].Resize(, s) = Ay: s = 0: Erase Ar
  14. Set Rng = Nothing
  15. For j = 0 To UBound(Ay)
  16.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
  17. Next
  18. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  19.     For Each A In Rng
  20.         If A = Application.Min(Rng) Then
  21.            ReDim Preserve Ar(s)
  22.            ReDim Preserve Ay(s)
  23.            Ar(s) = A.Address
  24.            Ay(s) = A.Column
  25.            s = s + 1
  26.         End If
  27.     Next
  28.     Cells(r, "H").Resize(, s) = Ay
  29. For j = 0 To UBound(Ay)
  30.    Set Rng = Union(Rng, Cells(2, Ay(j)))
  31. Next
  32. s = 0: Erase Ay: Erase Ar
  33. Next
  34. End Sub
複製代碼
另外用數字代替欄位OK的
Columns(1).Delete
作者: basarasy    時間: 2011-4-3 09:41

回復 2# Hsieh

謝謝大大的教導.

第1個問題只會出1個COL的數. 這個圖我做了所有可能.

    [attach]5224[/attach]
作者: Hsieh    時間: 2011-4-5 20:07

回復 3# basarasy
試試看
  1. Sub Ex()
  2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
  3. Set Rng = [A1:G1]
  4. For Each A In Rng
  5.    If A = Application.Max(Rng) Then '如果是最大值
  6.       ReDim Preserve Ar(s)
  7.       ReDim Preserve Ay(s)
  8.       Ar(s) = A.Address '記住位址
  9.       Ay(s) = A.Column '記住欄位
  10.       s = s + 1
  11.    End If
  12. Next
  13. s = 0: Erase Ar
  14. Set Rng = Nothing
  15. For j = 0 To UBound(Ay) '最大值的下一格儲存格聯集
  16.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
  17. Next
  18. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row '第2列以下迴圈
  19.     For Each A In Rng
  20.         If A = Application.Min(Rng) Then '如果是最小值
  21.            ReDim Preserve Ar(s)
  22.            ReDim Preserve Ay(s)
  23.            Ar(s) = A.Address '記住位址
  24.            Ay(s) = A.Column '記住欄位
  25.            s = s + 1
  26.         End If
  27.     Next
  28.     Set Rng = Nothing
  29. For j = 0 To UBound(Ay)
  30.    If Rng Is Nothing Then Set Rng = Cells(r, Ay(j)) Else Set Rng = Union(Rng, Cells(r, Ay(j)))
  31. Next
  32. ck = Ay(0)
  33. s = 0: Erase Ay: Erase Ar
  34. Next
  35. [H1] = ck
  36. End Sub
複製代碼
作者: basarasy    時間: 2011-4-5 20:30

回復 4# Hsieh


    謝謝Hsieh大大.
row1和row2 計算沒有問題.
row3有少少問題.
[attach]5246[/attach]
答案是7  但算出了是5
因為row3有2個條件
找出最少的數後 ,
條件1  只有1個最少的數  h1出最少的數的col
條件2  有2個or以上最少的數  出最左手邊的最少的數的col
所以 條件1+條件2= 只要出 最左手邊的最少的數的col 就ok.
作者: Hsieh    時間: 2011-4-5 20:57

回復 5# basarasy
  1. Sub Ex()
  2. Dim Ar(), Ay(), Rng As Range, A As Range, s%, j%
  3. Set Rng = [A1:G1]
  4. For Each A In Rng
  5.    If A = Application.Max(Rng) Then '如果是最大值
  6.       ReDim Preserve Ar(s)
  7.       ReDim Preserve Ay(s)
  8.       Ar(s) = A.Address '記住位址
  9.       Ay(s) = A.Column '記住欄位
  10.       s = s + 1
  11.    End If
  12. Next
  13. For j = 0 To UBound(Ay) '最大值的下一格儲存格聯集
  14.    If Rng Is Nothing Then Set Rng = Cells(2, Ay(j)) Else Set Rng = Union(Rng, Cells(2, Ay(j)))
  15. Next
  16. For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row '第2列以下迴圈
  17. s = 0: Erase Ar
  18. Set Rng = Nothing
  19. For j = 0 To UBound(Ay)
  20.    If Rng Is Nothing Then Set Rng = Cells(r, Ay(j)) Else Set Rng = Union(Rng, Cells(r, Ay(j)))
  21. Next
  22. s = 0: Erase Ay: Erase Ar
  23.     For Each A In Rng
  24.         If A = Application.Min(Rng) Then '如果是最小值
  25.            ReDim Preserve Ar(s)
  26.            ReDim Preserve Ay(s)
  27.            Ar(s) = A.Address '記住位址
  28.            Ay(s) = A.Column '記住欄位
  29.            s = s + 1
  30.         End If
  31.     Next
  32.     Set Rng = Nothing
  33.     ck = Ay(0)
  34. Next
  35. [H1] = ck
  36. End Sub
複製代碼
作者: basarasy    時間: 2011-4-5 21:46

回復 6# Hsieh

謝謝強大的Hsieh超級版主^^
真的很想學 如何把東西放入 集合 之後再放出來用><



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