彰化一整天的論壇

 找回密碼
 立即註冊
查看: 379|回復: 6

vba 條件式網底求救

[複製鏈接]
發表於 2017-7-3 17:56:31 | 顯示全部樓層 |閱讀模式
本帖最後由 JayLiang 於 2017-7-3 17:59 編輯

Image 001.jpg
目前小弟只能透過設定格式化的條件使該存儲格黃底

Image 002.jpg
可否整列都黃底?

Image 003.jpg
系統產生的資料在儲存格F140的函數為=SUBTOTAL(9,F2:F137)

Image 004.jpg
是否可以透過End(xlUp)這類型的vba找到後函數改為=ROUND(SUBTOTAL(9,F2:F137),2)

Image 005.jpg
下列四個對應的F欄想帶入函數
BATTERY
HEATSINK
MECH.PARTS
LABEL



Image 006.jpg

BATTERY  =D134*E134
HEATSINK  =D135*E135
MECH.PARTS =D136*E136
LABEL =D137*E137


欄位的部分會確定但是列數會應系統產生會數量會不同,麻煩高手指教


boomm.xlsm

52.25 KB, 下載次數: 66

回復

使用道具 舉報

發表於 2017-7-3 18:43:58 | 顯示全部樓層
整列變色,可以參考
http://wordpress.bestdaylong.com/blog/archives/7222
Excel 2010 如何設定儲存格會自動依某一欄條件整列變色
回復 支持 反對

使用道具 舉報

發表於 2017-7-3 19:05:23 | 顯示全部樓層
imingho 發表於 2017-7-3 18:43
整列變色,可以參考
http://wordpress.bestdaylong.com/blog/archives/7222
Excel 2010 如何設定儲存格會自 ...

尋找可以用
Range.Find
可以參考
https://msdn.microsoft.com/zh-tw/library/office/ff839746.aspx
回復 支持 反對

使用道具 舉報

發表於 2017-7-3 22:55:55 | 顯示全部樓層
imingho 發表於 2017-7-3 19:05
尋找可以用
Range.Find
可以參考

我寫了一個簡單的範例,您可以參考看看.
Excel如何利用range.find找到公式並修改
http://discuz.bestdaylong.com/fo ... 37806&fromuid=2
(出處: 彰化一整天的論壇)
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-7-5 13:49:08 | 顯示全部樓層
模組3目前可以順利運行

myNum1 = Application.InputBox("Enter a last cell ")
    With Range("F2:F65536")
        Set c = .Find("=SUBTOTAL(9,F2*", LookIn:=xlFormulas)
        If Not c Is Nothing Then
            c.Value = "=ROUND(SUBTOTAL(9,F2:" & myNum1 & "),2)"
        End If
    End With


透過手動的方輸入來達到函數的目的

MsgBox "目前作用中儲存格" & Selection.Address

有沒有可能性將Selection.Address變成變數帶入 myNum1

boomm-9.xlsm

197.77 KB, 下載次數: 54

回復 支持 反對

使用道具 舉報

發表於 2017-7-5 13:58:44 | 顯示全部樓層
JayLiang 發表於 2017-7-5 13:49
模組3目前可以順利運行

myNum1 = Application.InputBox("Enter a last cell ")

您可以在程式執行的第一行,先記住目前所在的儲存格.
  1. Sub Macro3()
  2. '
  3. ' Macro3 Macro
  4. '
  5. ' 快速鍵: Ctrl+u
  6. '

  7. '記住目前的儲存格
  8. myNum1 = Selection.Address


  9. '=============================顯示比例=====================
  10. ActiveWindow.Zoom = 80

  11. '=============================顯示比例=====================

  12. '=============================UP展開=======================

  13.     Range("E1").Select
  14.     ActiveSheet.Range("$A$1:$L$137").AutoFilter Field:=5
  15.    
  16. '    Range("E1").Select
  17. '    Selection.AutoFilter
  18. '=============================UP展開=======================

  19. ''============================移除PURGRP整欄================
  20. Dim DD, YY As String
  21. YY = "PURGRP" '刪除PURGRP的欄位
  22.   
  23.   For i = 1 To 10
  24.   Cells(1, i).Select
  25.   DD = Cells(1, i).Value
  26.       If YY = DD Then
  27.       Columns(i).Select
  28.       Selection.Delete Shift:=xlToLeft
  29.       Else
  30.       End If
  31.     Next i

  32. '    Columns("I:I").Select
  33. '    Selection.Delete Shift:=xlToLeft
  34. ''============================移除PURGRP整欄================

  35. '============================U/P等於0的時候黃底============
  36.     Range("J2").Select
  37.     Range(Selection, Selection.End(xlDown)).Select
  38.     Range(Selection, Selection.End(xlToLeft)).Select
  39.     Range(Selection, Selection.End(xlToLeft)).Select
  40.     Range(Selection, Selection.End(xlToLeft)).Select
  41.     Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E2=0"
  42.     Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  43.     With Selection.FormatConditions(1).Interior
  44.         .PatternColorIndex = xlAutomatic
  45.         .Color = 10092543
  46.         .TintAndShade = 0
  47.     End With
  48.     Selection.FormatConditions(1).StopIfTrue = False
  49. '============================U/P等於0的時候黃底============

  50. '============儲存格類別====================================
  51. Range("F65536").End(xlUp).Select
  52.     Range(Selection, Selection.End(xlUp)).Select
  53.     Range(Selection, Selection.End(xlUp)).Select
  54.     Selection.NumberFormatLocal = "#,##0.00_ ;[紅色]-#,##0.00 "
  55. '============儲存格類別====================================

  56. '=============================BATTERY到LABEL===============
  57.     Range("F2").Select
  58.     Selection.End(xlDown).Offset(1, 0).Select
  59.     ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
  60.    
  61.     Range("F2").Select
  62.     Selection.End(xlDown).Offset(1, 0).Select
  63.     ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
  64.    
  65.     Range("F2").Select
  66.     Selection.End(xlDown).Offset(1, 0).Select
  67.     ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
  68.    
  69.     Range("F2").Select
  70.     Selection.End(xlDown).Offset(1, 0).Select
  71.     ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
  72. '=============================BATTERY到LABEL===============

  73. '=============================ROUND(xxxx,2)================
  74. 'myNum1 = Application.InputBox("Enter a last cell ")
  75.     With Range("F2:F65536")
  76.         Set c = .Find("=SUBTOTAL(9,F2*", LookIn:=xlFormulas)
  77.         If Not c Is Nothing Then
  78.             c.Value = "=ROUND(SUBTOTAL(9,F2:" & myNum1 & "),2)"
  79.         End If
  80.     End With
  81. '=============================ROUND(xxxx,2)================

  82. 'Range("A1").Select

  83. End Sub
複製代碼

boomm-9.xlsm

197.61 KB, 下載次數: 0

售價: 1 金錢  [記錄]  [購買]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-7-5 17:50:44 | 顯示全部樓層
非常感謝版主熱心協助
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-9-22 03:23 , Processed in 0.151598 second(s), 22 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表