返回列表 上一主題 發帖

[發問] (已解決)浮動區域的作業

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
1# 跳轉到 »
發表於 2011-3-9 11:23 | 顯示全部帖子
回復 1# freeffly
如果樓主有空的話,可否試試我這個作品,有錯的話請通知我讓我改正
  1. Sub abc()
  2. Dim myrange As Range, downlimit As Range, uplimit As Range, rightlimit As Range, myregion As Range
  3. Dim a, h, i

  5. Set myrange = Range("a65536").End(xlUp)

  7. Do
  8. Set downlimit = myrange
  9. Set uplimit = downlimit.End(xlUp)
  10. Set rightlimit = downlimit.End(xlToRight)
  11. Set myregion = Range(uplimit, rightlimit)

  13. h = 0
  14. i = 0

  16. For Each a In Range(uplimit, downlimit)
  17. If a.Offset(, 6) = "O" Then
  18.     h = h + a.Offset(, 7).Value
  19.     i = i + a.Offset(, 8).Value
  20. End If
  21. Next

  23. If h <> 0 Then
  24. downlimit.Offset(1, 6) = "小計"
  25. downlimit.Offset(1, 7) = h
  26. downlimit.Offset(1, 8) = i
  27. downlimit.Offset(1, 9) = h / i
  28. downlimit.Offset(1, 7).Interior.ColorIndex = 6
  29. downlimit.Offset(1, 8).Interior.ColorIndex = 6
  30. downlimit.Offset(1, 9).Interior.ColorIndex = 6
  31. End If

  33. Set myrange = uplimit.End(xlUp)
  34. Loop While myrange.Address <> "$A$1"
  35. End Sub
複製代碼
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
2#
發表於 2011-3-9 20:17 | 顯示全部帖子
回復 17# freeffly
我猜想或許工作表中有很多區塊,當中一些又要對O作計算,所以寫成了loop
只對最下層區域作小計,把7/33/34行的程式刪掉便行
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
3#
發表於 2011-3-11 13:33 | 顯示全部帖子
回復 19# freeffly
把我的程式修改一下.變成
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
4#
發表於 2011-3-11 13:48 | 顯示全部帖子
  1. Sub revisedprogram()

  3. Dim myrange As Range, downlimit As Range, uplimit As Range, rightlimit As Range, myregion As Range

  5. Dim a, H, i
  6. Set myrange = Range("a65536").End(xlUp)

  8. Set downlimit = myrange
  9. Set uplimit = downlimit.End(xlUp)
  10. Set rightlimit = downlimit.End(xlToRight)
  11. Set myregion = Range(uplimit, rightlimit)

  13. H = 0
  14. i = 0

  16. For Each a In Range(uplimit, downlimit)
  17. 'if a.offset(,5) = "??材料倉" and a.offset(,6) = "?" ? => 自己填入所需的篩選項
  18. H = H + a.Offset(, 7).Value
  19. i = i + a.Offset(, 8).Value
  20. 'end if
  21. Next

  23. downlimit.Offset(1, 6) = "小計"
  24. downlimit.Offset(1, 7) = H
  25. downlimit.Offset(1, 8) = i
  26. downlimit.Offset(1, 9) = H / i
  27. downlimit.Offset(1, 7).Interior.ColorIndex = 6
  28. downlimit.Offset(1, 8).Interior.ColorIndex = 6
  29. downlimit.Offset(1, 9).Interior.ColorIndex = 6

  31. End Sub
複製代碼
應該這樣吧,如果沒有事先篩選,把綠色字串最初的那個 ' 拿掉,輸入所需就行
80 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題