问题描述
我要在背景黄色与单元格相同且背景白色为[0,0]的情况下打印值 对于这种情况，我想得到
[1,9]，[0,0]，[1,7]，[1,6]，[0,4]，[0,2] ，[0,0]
我写了一些代码
Dim isect As Range
Set isect = Intersect(Target,Me.Range("$B$80:$J$80"))
If Not isect Is nothing Then
Dim s As String
If Target.Interior.Color = vbYellow Then
s = Target.Value
Else
s = "[0,0]"
End If
Range("D96").Value = s
但是它仅获得一个值，这是我继续做的。 任何帮助将不胜感激。
解决方法
Dim isect As Range
Dim aCell As Range
Dim Output As String
Set isect = Intersect(target,Me.Range("$B$80:$J$80"))
If Not isect Is Nothing Then
For Each aCell In isect
If aCell.Interior.Color = vbYellow Then
Output = Output & "," & aCell.Value
Else
Output = Output & "," & "[0,0]"
End If
Next aCell
Range("D96") = Mid(Output,2)
End If
这是您想要的吗？
,取决于单元格属性（填充颜色）
标准模块代码（例如Module1）
Option Explicit
Function getString(SourceRange As Range,_
Optional ByVal FillColor As Long = 0,_
Optional ByVal CriteriaNotMetValue As Variant = Empty,_
Optional ByVal Delimiter As String = ",") _
As String
If SourceRange Is Nothing Then Exit Function
' Write values of range to array.
Dim Data As Variant
If SourceRange.Rows.Count > 1 Or SourceRange.Columns.Count > 1 Then
Data = SourceRange.Value
Else
ReDim Data(1 To 1,1 To 1): Data(1,1) = SourceRange.Value
End If
' Modify values in array.
Dim i As Long,j As Long,Result As String
For i = 1 To UBound(Data)
For j = 1 To UBound(Data,2)
If SourceRange.Cells(i,j).Interior.Color <> FillColor Then
Data(i,j) = CriteriaNotMetValue
End If
Result = Result & Delimiter & Data(i,j)
Next j
Next i
' Remove redundant Delimiter.
getString = Right(Result,Len(Result) - Len(Delimiter))
End Function
工作表代码（例如Sheet1）
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const rngAddress As String = "B80:J80"
Const cellAddress As String = "D96"
Const CriteriaNotMetValue As Variant = "[0,0]"
Const FillColor As Long = vbYellow
Const Delimiter As String = ","
If Intersect(Me.Range(rngAddress),Target) Is Nothing Then Exit Sub
On Error GoTo clearError
Application.EnableEvents = False
Dim Result As String
Result = getString(Me.Range(rngAddress),FillColor,CriteriaNotMetValue,Delimiter)
Me.Range(cellAddress).Value = Result
CleanExit:
Application.EnableEvents = True
Exit Sub
clearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
On Error GoTo 0
GoTo CleanExit
End Sub