[發問] COLUMN問題

basarasy

請問大大2個問題.

第1個是圖片中的問題.

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

下載 (102.57 KB)

2011-4-1 22:40

Hsieh

回復 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

回復 2# Hsieh

謝謝大大的教導.

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

   

下載 (147.77 KB)

2011-4-3 09:39

Hsieh

回復 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

回復 4# Hsieh


    謝謝Hsieh大大.
row1和row2 計算沒有問題.
row3有少少問題.

下載 (17.23 KB)

2011-4-5 20:23

答案是7  但算出了是5
因為row3有2個條件
找出最少的數後 ,
條件1  只有1個最少的數  h1出最少的數的col
條件2  有2個or以上最少的數  出最左手邊的最少的數的col
所以 條件1+條件2= 只要出 最左手邊的最少的數的col 就ok.

Hsieh

回復 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

回復 6# Hsieh

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