Question

我有一个由字符串和数字组成的表格。第一行包含标题，第二行包含单位类型（百分比和美元）。我想根据第二行的标题将列中的数字四舍五入。

目前，我正在分别选择列。有没有一种方法可以根据第二行中的标题来舍入该列？

Sub Round()

Dim Lastrow As Long
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'Determine 
last row

        For Each cell In ActiveSheet.Range("R3:R" & Lastrow)
        cell.Value = WorksheetFunction.Round(cell.Value, 2) 'Round dollars to 2 places
        Next cell

        For Each cell In ActiveSheet.Range("AB3:AB" & Lastrow)
        cell.Value = WorksheetFunction.Round(cell.Value, 2)
        Next cell

       For Each cell In ActiveSheet.Range("Q3:Q" & Lastrow)
       cell.Value = WorksheetFunction.Round(cell.Value, 1) 'Round percentages to 1 places
       Next cell

       ....

End Sub

Answer 1

您已经足够亲密，这两次尝试都需要一点。请查看以下内容是否有帮助，我还添加了一个使用数组的替代方法（如果您有大量数据，它将更快）：

Sub RoundRanges()

Dim ws As Worksheet: Set ws = ActiveSheet 'better use something like: ActiveWorkbook.Sheets("Sheet name here")
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'get last row
Dim lCol As Long: lCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column 'get last column

Dim R As Long, C As Long

For C = 1 To lCol 'iterate through each column
    Select Case ws.Cells(2, C) 'get the text of the cell 2...
        Case "Percent"
            For R = 3 To lRow 'iterate through each row
                ws.Cells(R, C) = WorksheetFunction.Round(ws.Cells(R, C).Value, 1) 'apply the desired calculation
            Next R
        Case "Dollars"
            For R = 3 To lRow 'iterate through each row
                ws.Cells(R, C) = WorksheetFunction.Round(ws.Cells(R, C).Value, 2) 'apply the desired calculation
            Next R
    End Select
Next C

'ALTERNATIVE:
'Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol))
'For R = LBound(arrData) + 2 To UBound(arrData) 'skip first 2 rows
'    For C = LBound(arrData, 2) To UBound(arrData, 2)
'        If arrData(2, C) = "Percent" Then
'            arrData(R, C) = Round(arrData(R, C), 1)
'        ElseIf arrData(2, C) = "Dollars" Then
'            arrData(R, C) = Round(arrData(R, C), 2)
'        End If
'    Next C
'Next R
'ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData

End Sub

如何根据标题类型对列进行取整

1 个答案: