[英]Autoformat row based on values in each cell using Excel VBA?
我有Table1
A欄的日期為30/5/2017
B列有狀態,例如“成功”
C列具有例如500的值
要求:更改單元格時在VBA中應用自定義條件格式
假設改變發生在第5行的A,B或C列中
無論更改是在A列,B列還是C列中發生,都應執行相同的邏輯。
如果列A值小於Now(),則第5行應為紅色背景和白色文本。 不應該進行進一步的檢查。
否則,如果B列為“成功”,則第5行應為綠色背景和白色文本。 不應該進行進一步的檢查。
否則如果C列的值小於500,則第5行應為藍色背景和白色文本。 不應該進行進一步的檢查。
下面的VBA代碼是檢查單元格上的更改 - 它使用超鏈接自動格式化b列中的單元格。
我現在需要的是根據上述標准自動整形整行。
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Not Intersect(Target, Range("B:B")) Is Nothing) Or (Not Intersect(Target, Range("F:F")) Is Nothing) Or (Not Intersect(Target, Range("G:G")) Is Nothing) Or (Not Intersect(Target, Range("I:I")) Is Nothing)) Then
End If
End Sub
試試這段代碼:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set Rng = Application.Intersect(Target, Columns("A:C"))
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Rng.EntireRow, Columns("A:C"))
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
R.EntireRow.Interior.Color = bCol
R.EntireRow.Font.Color = fCol
Next
End If
End Sub
編輯 :
我有Table1
如果Table1是ListObject
( Excel表格 ),那么我們可以修改上面的代碼,使其無論第一列的起始位置(在“A”或“B”列等等中),都可以觀察該表的前三列,並且只格式化表行而不是EntireRow:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LObj As ListObject
Dim RngToWatch As Range
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set LObj = ListObjects("Table1") ' the name of the table
Set RngToWatch = Range(LObj.ListColumns(1).DataBodyRange, LObj.ListColumns(3).DataBodyRange)
Set Rng = Application.Intersect(Target, RngToWatch)
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Target.EntireRow, RngToWatch)
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
With Application.Intersect(LObj.DataBodyRange, R.EntireRow)
.Interior.Color = bCol
.Font.Color = fCol
End With
Next
End If
End Sub
我假設你的表(有三列)出現在Sheet1中。 因此,在Sheet1中添加以下代碼(不在單獨的模塊中)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irow As Variant
' First identify the row changed
irow = Target.Row
' Invoke row formatter routine
Call DefineFormat(irow)
End Sub
然后在模塊中添加以下代碼(您可以在Sheet1下添加,但它將限制此模塊的用途)
Sub DefineFormat(irow) ' Receive the row number for processing
Dim vVal As Variant
Dim Rng As Range
Dim lFont, lFill As Long
' Define the basis for validation
Dim Current, Success, limit As Variant ' Can be defined as constant as well
Current = Date ' Set today's date
Success = "Success" ' Set success status check
limit = 500 ' Set limit for value check
' Set range for the entire row - Columns A(index 1) to Column C (index 3)
Set Rng = Range(Application.ActiveSheet.Cells(irow, 1).Address, Application.ActiveSheet.Cells(irow, 3).Address)
lFont = vbWhite
' Assuming columns A, B and C needs to be formatted
If Application.ActiveSheet.Cells(irow, 1) < Current Then
lFill = vbRed ' Check for col A
Else:
If Application.ActiveSheet.Cells(irow, 2) = Success Then
lFill = vbGreen ' Check for col B
Else
If Application.ActiveSheet.Cells(irow, 3) < limit Then
lFill = vbBlue ' Check for col C
Else ' Default formatting
lFill = xlNone
lFont = vbBlack
End If
End If
End If
Rng.Interior.Color = lFill
Rng.Font.Color = lFont
End Sub
這將在修改數據時格式化行(就像條件格式一樣)
此外,如果您需要一次性格式化整個表,那么您可以在表的每一行的循環中調用DefineFormat例程,如Fadi在其回復中所示。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.