英文:
Loop through cells and change font
问题
我正在尝试循环遍历一行中的所有单元格,并根据以下条件更改字体大小:
- 如果字体大小小于10,则将字体大小更改为10。
如果工作表中的所有单元格都具有相同的字体大小,则这将起作用。如果工作表中的任何单元格具有不同的字体大小,则会返回null
。如果A1中的字体大小为8,而A2中的字体大小为20,则不会更改。
以下是一个处理一列的示例代码:
Sub SetColumnFont(columnRange As Range)
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In columnRange
' 如果字体大小小于10,则将字体大小更改为10
If cell.Font.Size < 10 Then cell.Font.Size = 10
Next
Application.ScreenUpdating = True
End Sub
要使用此代码,您可以将目标列的范围作为参数传递给SetColumnFont
子例程。这将处理一整列并根据您的条件更改字体大小。
英文:
I'm trying to loop through all cells in a row and change the font size using the following criteria:
- If the font size is less than 10, then change the font size to 10
This works if all cells in the worksheet are the same font size. It returns null
if any of the cells in the sheet have a different font size. If I have a font size of 8 in A1 and a size of 20 in A2, there is no change.
Sub SetSheetFont(ws As Worksheet)
Dim x As Integer
Dim NumRows As Long
Application.ScreenUpdating = False
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
Range("A1").Select
With ws
' If the font size is lower than 10, set to 10
For x = 1 To NumRows
If .Cells.Font.Size < 10 Then .Cells.Font.Size = 10
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End With
End Sub
The end goal is to loop through all cells in the column until there is a certain number of empty cells, then start on the next column (in this case B1).
How might I at least accomplish this in one column? I'm pretty sure I can get it working if I start there.
答案1
得分: 3
你可以循环遍历UsedRange
中的所有单元格。
Sub SetSheetFont(ws As Worksheet)
Dim myCell As Range
Application.ScreenUpdating = False
With ws
For Each myCell In .UsedRange
' 如果字体大小小于10,设置为10
If myCell.Font.Size < 10 Then myCell.Font.Size = 10
Next
End With
Application.ScreenUpdating = True
End Sub
附注:一般情况下,你应该避免在代码中使用Select。
英文:
You can loop through all the cells in the UsedRange
Sub SetSheetFont(ws As Worksheet)
Dim myCell As Range
Application.ScreenUpdating = False
With ws
For each myCell in ws.UsedRange
' If the font size is lower than 10, set to 10
If myCell.Font.Size < 10 Then myCell.Font.Size = 10
Next
End With
Application.ScreenUpdating = True
End Sub
Side note: in general, you want to avoid using select in your code
答案2
得分: 3
根据我的评论,我认为这可能是使用 FindFormat
和 ReplaceFormat
的一个很好的用例:
Dim x As Double
' 仅设置一次 ReplaceFormat
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Font.Size = 10
' 在 For 循环中设置 FindFormat
For x = 1 To 9.5 Step 0.5
Application.FindFormat.Clear
Application.FindFormat.Font.Size = x
ws.Cells.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True
Next x
这可以避免迭代所有 ws.Cells
。循环是必要的,因为我们不能设置类似于:Application.FindFormat.Font.Size < 10
。并且因为 Font.Size
会自动调整(至少对我来说),调整到最近的 0.5(1 是最小的大小),我们可以从 1 到 9.5 以 0.5 的步长进行遍历。
根据您的描述,您可能希望改为使用 ws.UsedRange
,如 @cybernetic.nomad 所提到的。这样就会变成:ws.UsedRange.Replace...
。
英文:
As per my comment, I think this could be a good usecase for FindFormat
and ReplaceFormat
:
Dim x As Double
'Set ReplaceFormat just once
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Font.Size = 10
'Set FindFormat in a For loop
For x = 1 To 9.5 Step 0.5
Application.FindFormat.Clear
Application.FindFormat.Font.Size = x
ws.Cells.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True
Next x
This prevents iteration over all ws.Cells
. The loop is necessary because we cant set something like: Application.FindFormat.Font.Size < 10
. And because Font.Size
will auto-adjust (at least for me) to the nearest 0.5 (and 1 being the smallest size) we can step from 1 to 9.5 with a step of 0.5.
And as per your description, you might want to change it up to ws.UsedRange
as per @cybernetic.nomad mentioned. So it would read: ws.UsedRange.Replace...
答案3
得分: 2
以下是翻译的内容:
保留您的代码,如下所述,您想要访问每个单元格(而不是所有单元格,这就是.Cells.
所做的事情:
For x = 1 To NumRows
If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
Next
这将循环遍历A列(.Cells(x,1)
中的1
)。
我还建议在列A中有一个空行分隔数据的情况下使用.End(xlUp)
,而不是xlDown
。如果这没问题,那么您可以保留它...另一种选择是:NumRows = Range("A" & rows.count).End(xlUp).row
(还要使用Long
类型来声明x
):
Sub SetSheetFont(ws As Worksheet)
Dim x As Long, NumRows as Long
Application.ScreenUpdating = False
With ws
NumRows = .Range("A" & rows.count).End(xlUp).Row
' 如果字体大小小于10,设置为10
For x = 1 To NumRows
If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
Next
Application.ScreenUpdating = True
End With
End Sub
编辑:要确保,xlDown
也能工作,只是注意它将在第一个空单元格处停止。像我所做的那样使用xlUp
将确保获取列A中的所有行,这可能是您想要的,也可能不是。
英文:
Keeping your code, as commented, you would want to access each cell (not all cells, which is what .Cells.
does:
For x = 1 To NumRows
If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
Next
This will loop through column A. (the 1
in .Cells(x,1)
).
I would also suggest using .End(xlUp)
instead of xlDown
, in the event your column A has a blank row separating Data. If that's okay, then you can keep it...the other option is: NumRows = Range("A" & rows.count).End(xlUp).row
(Also, use Long
for x
:
Sub SetSheetFont(ws As Worksheet)
Dim x As Long, NumRows as Long
Application.ScreenUpdating = False
With ws
NumRows = .Range("A" & rows.count).End(xlUp).Row
' If the font size is lower than 10, set to 10
For x = 1 To NumRows
If .Cells(x,1).Font.Size < 10 Then .Cells(x,1).Font.Size = 10
Next
Application.ScreenUpdating = True
End With
End Sub
Edit: To be sure, xlDown
will work, just note it'll stop at the first Empty cell. Using xlUp
as I did, will be sure to get all rows in Column A...which may or may not be what you want.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论