将单元格值替换为包含excel中的总百分比

时间:2016-07-07 11:41:42

标签: excel vba excel-vba

我有一张excel表,其中包含实体,它们的特征,特征值和总数如下:

Entity  CHAR1   CHAR2   CHAR3   CHAR4   Total
1       10      20      5       5       40
2       5       100     30      25      160
3       25      25      10      20      80

现在我想用百分比替换值,其中每行的总列被视为100%。 在这个例子中,这将导致:

Entity  CHAR1   CHAR2   CHAR3   CHAR4
1       25      50      12,5    12,5
2       3,125   62,5    18,75   15,625
3       31,25   31,25   12,5    25

由于我的数据集非常大,我想知道是否有快速解决方案可以做到这一点?我被卡住了,因为在每个单元格中放置一个公式将需要使用单元格本身中的旧值来计算新值。使用新的工作表可能会给我一些性能问题。

提前致谢

2 个答案:

答案 0 :(得分:2)

运行此子程序,所有内容应该按照您的要求运行(请注意,您需要定义TotalColumn列号(因为在示例中不明显)

Sub MakePercent()
     Dim Cell As Range, CalcRange As Range, TotalColumn As Variant
     TotalColumn = 'Write the column number or letter here 
     Set CalcRange = ActiveSheet.Range(ActiveSheet.Cells(2,2), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count,TotalColumn - 1))
     For Each Cell In CalcRange
         Cell.Value = CDbl(Cell.Value) / CDbl(ActiveSheet.Cells(Cell.Row,totalColumn))
     Next Cell

End Sub

答案 1 :(得分:1)

我自己的小更新:

RGA提供的宏工作正常,直到我用一些额外的列扩展我的数据。然后它导致excel冻结,因此我去寻找新的解决方案。

如果找到以下stackoverflow question并将Application.ScreenUpdating = false添加到开头,则Application.ScreenUpdating = true添加到宏的末尾解决了冻结问题。

这导致以下代码:

Sub MakePercent()

     Application.ScreenUpdating = False

     Dim Cell As Range, CalcRange As Range, TotalColumn As Variant
     TotalColumn = 'Write the column number or letter here 
     Set CalcRange = ActiveSheet.Range(ActiveSheet.Cells(2,2), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count,TotalColumn - 1))
     For Each Cell In CalcRange
         Cell.Value = CDbl(Cell.Value) / CDbl(ActiveSheet.Cells(Cell.Row,totalColumn))
     Next Cell

     Application.ScreenUpdating = True

End Sub