我希望我的电子表格中的单元格可以使单元格的一部分变为粗体。我发现了一个类似的帖子。它在某种程度上确实有效。它在第一次更新单元格时有效，但如果单元格更新，则一切都变为粗体。我在前两列（switch语句中的情况9和10）中使用了上面链接中描述的方法，但是在我能够正常工作之前不想更新其他列
Private Sub Worksheet_Change(ByVal Target As Range)
Dim comment As String
Dim time As String
Dim StartCell As String
Dim EndCell As String
Dim pos As Integer
Dim newComment As String
If Target.Cells.CountLarge > 1 Then
Exit Sub
End If
StartCell = "A" & Target.Row
EndCell = "W" & Target.Row
time = Target.Value
time = Format(Target.Value, "h:mm AM/PM")
comment = Range("S" & Target.Row).Value
If Not Intersect(Target, Range("I4:R254")) Is Nothing Then
If Target.Value <> "" Then
Select Case Target.Column
Case 9
newComment = time & " EST Tech on site, initial prep, SW and SO# verified"
pos = InStr(newComment, "EST")
If comment = "" Then
Range("S" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified"
Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
Else
Range("S" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified" & Chr(10) & comment
Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
End If
Range("R" & Target.Row) = "In Progress"
Case 10
newComment = time & " EST Installing HW" & Chr(10) & comment
pos = InStr(newComment, "EST")
If Range("J" & Target.Row).Value < Range("I" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 2 must be greater than Checkpoint 1")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Installing HW" & Chr(10) & comment
Range("S" & Target.Row).Characters(Start:=1, Length:=pos - 1).Font.Bold = True
End If
Case 11
If Range("K" & Target.Row).Value < Range("J" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 3 must be greater than Checkpoint 2")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Phase 1 SW Installation" & Chr(10) & comment
End If
Case 12
If Range("L" & Target.Row).Value < Range("K" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 4 must be greater than Checkpoint 3")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Running TPM and checking devices" & Chr(10) & comment
End If
Case 13
If Range("M" & Target.Row).Value < Range("L" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 5 must be greater than Checkpoint 4")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Phase 2 SW Installation" & Chr(10) & comment
End If
Case 14
If Range("N" & Target.Row).Value < Range("M" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 6 must be greater than Checkpoint 5")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Post Imaging Tasks" & Chr(10) & comment
End If
Case 15
If Range("O" & Target.Row).Value < Range("N" & Target.Row).Value Then
MsgBox ("Time for Checkpoint 7 must be greater than Checkpoint 6")
Target.Value = ""
Target.Select
Else
Range("S" & Target.Row) = time & " EST Upgrade Complete" & Chr(10) & comment
Range("R" & Target.Row) = "Complete"
End If
Case 18
Select Case Target.Value
Case ""
Range(StartCell, EndCell).Interior.ColorIndex = 0
Range(StartCell, EndCell).Font.ColorIndex = 1
Case "Pending"
Range(StartCell, EndCell).Interior.ColorIndex = 0
Range(StartCell, EndCell).Font.ColorIndex = 1
Case "En Route"
Range(StartCell, EndCell).Interior.ColorIndex = 15
Range(StartCell, EndCell).Font.ColorIndex = 1
Case "In Progress"
Range(StartCell, EndCell).Interior.ColorIndex = 36
Range(StartCell, EndCell).Font.ColorIndex = 1
Case "Complete"
Range(StartCell, EndCell).Interior.Color = RGB(84, 130, 53)
Range(StartCell, EndCell).Font.Color = RGB(255, 255, 204)
Case "Cancelled"
Range(StartCell, EndCell).Font.ColorIndex = 3
Case "Rescheduled"
Range(StartCell, EndCell).Interior.ColorIndex = 0
Range(StartCell, EndCell).Font.ColorIndex = 3
Case "Carryover"
Range(StartCell, EndCell).Interior.Color = RGB(0, 153, 255)
Range(StartCell, EndCell).Font.ColorIndex = 3
End Select
End Select
End If
End If
End Sub
答案 0 :(得分：3)
如果无论如何你可以避免单独格式化字符，你应该。你将花费大量时间在它上面，当你认为自己已经拥有它时，有人会找到一种方法来打破它。就像你只是把时间放在自己的牢房里一样，你会更开心。话虽如此，这会让你接近，你可以从那里调整它。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLog As Range
Dim sInput As String
Dim aMsg(1 To 7) As String
Dim i As Long
Dim sTime As String
Dim lBoldEnd As Long
Const TIMESAVE As String = "EDT"
If Target.Cells.CountLarge > 1 Then
Exit Sub
End If
aMsg(1) = "Tech on site, initial prep, SW and SO# verified"
aMsg(2) = "Installing HW"
aMsg(3) = "Phase 1 SW Installation"
aMsg(4) = "Running TPM and checking devices"
aMsg(5) = "Phase 2 SW Installation"
aMsg(6) = "Post Imaging Tasks"
aMsg(7) = "Upgrade Complete"
If Not Intersect(Target, Me.Range("I4:O254")) Is Nothing Then
If Not IsEmpty(Target.Value) Then
If Target.Column > 9 And Target.Value < Target.Offset(0, -1).Value Then
MsgBox "Time for checkpoint " & Target.Column - 8 & " must be less than time for checkpoint " & Target.Column - 7
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Else
Set rLog = Me.Cells(Target.Row, 19) 's
sTime = Format(Target.Value, "hh:mm AM/PM """ & TIMESAVE & """")
Application.EnableEvents = False
rLog.Font.Bold = False
If IsEmpty(rLog.Value) Then
rLog.Value = sTime & Space(1) & aMsg(Target.Column - 8)
Else
rLog.Value = sTime & Space(1) & aMsg(Target.Column - 8) & Chr$(10) & rLog.Value
End If
rLog.Characters(1, Len(sTime)).Font.Bold = True
For i = Len(sTime) To Len(rLog.Value)
If Mid$(rLog.Value, i, 1) = Chr$(10) Then
lBoldEnd = InStr(1, Mid$(rLog.Value, i + 1, Len(rLog.Value)), TIMESAVE) + Len(TIMESAVE)
If lBoldEnd > 0 Then
rLog.Characters(i + 1, lBoldEnd).Font.Bold = True
End If
End If
Next i
rLog.WrapText = True
Application.EnableEvents = True
End If
End If
End If
End Sub
对于第18列内容，您应该使用条件格式而不是在代码中执行。此外，这是白天时间，如果这对你很重要。