返回列表 上一主題 發帖

[發問] COLUMN問題

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-4-1 22:43 | 只看該作者

[發問] COLUMN問題

請問大大2個問題.

第1個是圖片中的問題.

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

收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 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
學海無涯_不恥下問

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
3#
發表於 2011-4-3 09:41 | 只看該作者
回復 2# Hsieh

謝謝大大的教導.

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

   
50 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
5#
發表於 2011-4-5 20:30 | 只看該作者
回復 4# Hsieh


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

答案是7  但算出了是5
因為row3有2個條件
找出最少的數後 ,
條件1  只有1個最少的數  h1出最少的數的col
條件2  有2個or以上最少的數  出最左手邊的最少的數的col
所以 條件1+條件2= 只要出 最左手邊的最少的數的col 就ok.
50 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
7#
發表於 2011-4-5 21:46 | 只看該作者
回復 6# Hsieh

謝謝強大的Hsieh超級版主^^
真的很想學 如何把東西放入 集合 之後再放出來用><
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
返回列表 上一主題