在excl中用VBA查找内容并设置字体及大小
要求:1、用VBA查找班级课程表、教师课程表中的“*课程表”,并设置“*课程表”的字体为“仿宋_GB2312”,字号为“20”,字体颜色为红色,背景色为黄色。2、用VBA查找班级课课表、教师课程表中的“早自习、上午、下午、晚自习”,并设置“早自习、上午、下午、晚自习”的字体为“仿宋_GB2312”,字号为“18”号。
VBA查找内容并设置字体及大小.rar
(32.02 KB)
Sub FindCell() ' 查找班级课程表、教师课程表中的“*课程表”, ' Dim sht As Worksheet, rng As Range, lStop As Boolean Dim arrsht() arrsht = Array("教师课程表", "班级课程表") Worksheets("要求").Activate For Each shtName In arrsht lStop = False Set sht = Worksheets(shtName) sht.Activate sht.Range("A1").Activate If InStr(1, sht.Range("A1").Value, "课程表", vbTextCompare) > 0 Then Call SetFont1(sht.Range("A1")) End If While lStop = False Set rng = Cells.Find(What:="课程表", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , MatchByte:=False, SearchFormat:=False) ad1 = rng.AddressLocal rng.Activate If rng.Row = 1 Then lStop = True Else Call SetFont1(rng) rng = sht.Cells.FindNext(After:=ActiveCell) ad1 = rng.AddressLocal End If Wend Next shtName End Sub Sub SetFont1(rng1 As Range) '设置 字体为“仿宋_GB2312”,字号为“20”,字体颜色为红色,背景色为黄色。 With rng1.Font .Name = "仿宋_GB2312" .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With With rng1.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With With rng1.Font .Color = -16776961 .TintAndShade = 0 End With End Sub
[此贴子已经被作者于2022-6-13 16:24编辑过]
Sub FindCell() ' 查找班级课程表、教师课程表中的“*课程表”, ' Dim sht As Worksheet, rng As Range, lStop As Boolean Dim arrsht() arrsht = Array("教师课程表", "班级课程表") Worksheets("要求").Activate For Each shtName In arrsht lStop = False Set sht = Worksheets(shtName) sht.Activate sht.Range("A1").Activate If InStr(1, sht.Range("A1").Value, "课程表", vbTextCompare) > 0 Then Call SetFont1(sht.Range("A1")) End If While lStop = False Set rng = Cells.Find(What:="课程表", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , MatchByte:=False, SearchFormat:=False) ad1 = rng.AddressLocal rng.Activate If rng.Row = 1 Then lStop = True Else Call SetFont1(rng) rng = sht.Cells.FindNext(After:=ActiveCell) ad1 = rng.AddressLocal End If Wend Next shtName End Sub Sub FindCell2() ' 查找班级课课表、教师课程表中的“早自习、上午、下午、晚自习” Dim sht As Worksheet Dim rng As Range Dim arr11() arrsht = Array("教师课程表", "班级课程表") Worksheets("要求").Activate For Each shtName In arrsht Set sht = Worksheets(shtName) sht.Activate sht.Range("A1").Activate Set rng = Range(sht.Cells(1, 1), sht.Cells(sht.UsedRange.Rows.Count, 1)) arr11 = rng.Value For ii = 1 To UBound(arr11, 1) If InStr(1, "早自习、上午、下午、晚自习", arr11(ii, 1), vbTextCompare) > 0 Then Set rng = sht.Cells(ii, 1) Call SetFont1(rng, 2) End If Next ii Next shtName End Sub Sub SetFont1(rng1 As Range, Optional itype As Integer = 0) '设置 字体为“仿宋_GB2312”,字号为“20”,字体颜色为红色,背景色为黄色。 With rng1.Font .Name = "仿宋_GB2312" .Size = IIf(itype = 0, 20, 18) .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With If itype = 0 Then With rng1.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With With rng1.Font .Color = -16776961 .TintAndShade = 0 End With End If End Sub