循环遍历单元格并更改字体

huangapple go评论156阅读模式
英文:

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(&quot;A1&quot;, Range(&quot;A1&quot;).End(xlDown)).Rows.Count
    Range(&quot;A1&quot;).Select
    With ws
        &#39; If the font size is lower than 10, set to 10
        For x = 1 To NumRows
            If .Cells.Font.Size &lt; 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
            &#39; If the font size is lower than 10, set to 10
            If myCell.Font.Size &lt; 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

根据我的评论,我认为这可能是使用 FindFormatReplaceFormat 的一个很好的用例:

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

&#39;Set ReplaceFormat just once
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Font.Size = 10

&#39;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:=&quot;&quot;, Replacement:=&quot;&quot;, 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 &lt; 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 &lt; 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 &lt; 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 &lt; 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(&quot;A&quot; &amp; 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(&quot;A&quot; &amp; rows.count).End(xlUp).Row
        &#39; If the font size is lower than 10, set to 10
        For x = 1 To NumRows
            If .Cells(x,1).Font.Size &lt; 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.

huangapple
  • 本文由 发表于 2020年1月3日 23:58:42
  • 转载请务必保留本文链接:https://go.coder-hub.com/59581598.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定