如何在工作簿的其余部分(但仅在每个 sheet 的选定单元格范围内)在 2 种货币 USD 和 AED @rate of 3.68 之间进行转换?
How can I convert between 2 currencies USD and AED @rate of 3.68 throughout the rest of my workbook but only in selected cell ranges on each sheet?
例如。我希望我的简介 sheet "Main Sheet" 可以选择在不同货币之间切换工作簿。美元和迪拉姆汇率为 3.68。有些单元格引用了不同 sheet 中的其他单元格,所以我不想更改单元格引用,我只需要计算每个 sheet 中特定单元格的速率。
我怎样才能最好地使用复选框或按钮来完成此操作,以便从一开始就轻松转换。我将 excel 用于 Mac。谢谢
创建一个带有验证下拉列表的单元格,允许在 AED 和 USD 之间进行选择。将该单元格转换为命名范围,以便在整个工作簿中轻松引用。您可以将其称为 "Curr","Currency" 的缩写(简称,因为它会经常使用)。
我建议您在输入汇率的地方创建一个类似的单元格,目前为 3.68,但计划仅更改该单元格中的汇率并将其应用于所有工作簿。将该单元格命名为 "Rate".
现在所有包含您可能想要切换的值的单元格都将遵循以下公式。 =[CellValue] * IF(Curr = "AED", Rate, 1)
。此公式假定所有值均以美元输入。如果将它们输入 AED,则公式应如下所示。 = ROUND([CellValue] / IF(Curr = "AED", 1, Rate), 2)
如您所见,此解决方案需要将原始单元格值记录在某处,这意味着用于数据捕获的单元格不能与用于数据显示的单元格相同。如果您希望坚持在同一个单元格中捕获和显示,则需要代码来进行转换。
从表面上看,这似乎很简单:当 Curr
选择更改时,所有具有受影响值的单元格都会重新计算。在实践中,这将以灾难告终,因为有 1001 种方式可能会出错,然后您将丢失所有数据,而不知道此时值是美元还是 AED。
因此,出发点需要是将数据捕获和数据显示分开。一旦完成,工作表函数可能不仅是实现您想要的最简单而且最有效的方法。
我假设您想对输入单元格进行转换,并且并非所有单元格都是公式,并且您要转换的许多单元格都是值。您应该认真考虑将输入与显示分开的答案,这将更加万无一失,并且不受任何可能破坏您的工作簿的逻辑的影响。
如果您热衷于此,请执行以下操作,但是,在您执行之前... 备份您的工作簿。我用以下代码完成的任何测试都没有中断,但我没有你的工作簿,因此,我不做任何保证。
首先,您需要一个显示当前汇率的单元格。您需要为该单元格指定 ExchangeRate.
的命名范围
在我的工作簿中,该单元格包含一个公式...
=IF(B1="USD",1,3.68)
看起来像这样...
... 并且单元格 B1 附有验证,允许您从 2 种货币 select,AED 或 USD.
您说您希望能够确保只有 select 离子的细胞会被转化。为确保我们仅围栏那些单元格,您需要创建一个命名范围 ON EACH SHEET,其中包含所有这些单元格。
该范围的名称需要称为 CellsToConvert,您可以通过名称管理器来完成。 创建命名范围时,请确保您指定了要为其创建的作品sheet,不要select编辑"Workbook"选项。
...下面显示了我在第一个 sheet 上使用的零星范围。所有彩色单元格都是该范围的一部分。绿色单元格包含值,黄色单元格包含公式。
在一天结束时,这个范围可能很大并且跨越不同的 sheets 但它应该有效。
现在,将以下代码添加到 VBA 编辑器中的 ThisWorkbook 对象中...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim objCell As Range, dblExRate As Double, strFormula As String, objSheet As Worksheet
Dim strNewFormula As String, strOpeningChar As String, bIsFormula As Boolean
Dim objCells As Range, strError As String, strExRateRangeName As String
strExRateRangeName = "ExchangeRate"
dblExRate = Range(strExRateRangeName)
Application.EnableEvents = False
For Each objSheet In Worksheets
On Error Resume Next
strError = ""
Err.Clear
Set objCells = objSheet.Range("CellsToConvert")
strError = Err.Description
On Error GoTo 0
If strError = "" Then
For Each objCell In objCells
strFormula = objCell.FormulaR1C1
bIsFormula = False
' Check to make sure this field contains a formula.
If Left(strFormula, 1) = "=" And objCell.NumberFormat <> "@" Then
bIsFormula = True
End If
If dblExRate = 1 Then
' Base currency selected.
' Check to see if the cell contains a formula, if it does,
' convert it back to a value
If bIsFormula Then
' It's a formula and the cell is not set to text, proces it back
' to its original value, that could still be a formula.
' Remove all of the exchange rate components we would've added as
' a part of this routine.
strNewFormula = Replace(strFormula, ") * " & strExRateRangeName, "")
' Check to see if the formula has changed against the previous statement,
' if it has, then it contained the custom additions, otherwise, it didn't.
If strFormula <> strNewFormula Then
strNewFormula = Mid(strNewFormula, 3)
' Check to see if the new value is numeric, if it is, remove the leading
' equals sign as it wasn't originally a formula, or, at least it doesn't
' need to be a formula.
If IsNumeric(strNewFormula) Then
objCell.Value = strNewFormula
Else
objCell.FormulaR1C1 = "=" & strNewFormula
End If
End If
End If
Else
' Something other than the base currency has been selected.
strNewFormula = objCell.FormulaR1C1
If InStr(1, strNewFormula, strExRateRangeName, vbTextCompare) = 0 Then
If bIsFormula Then strNewFormula = Mid(objCell.FormulaR1C1, 2)
objCell.FormulaR1C1 = "=(" & strNewFormula & ") * " & strExRateRangeName
End If
End If
Next
End If
Next
Application.EnableEvents = True
End Sub
...完成上述所有操作后,它应该适合您。如果工作簿很大,可以测试性能,但这需要您自己检查。
如果您更改了一个单元格并且它在这些范围之一内并且美元货币不是 selected,您将在按 Enter 后看到输入值更改为公式。当您考虑时,这非常简洁,但可能不适合您。
最后一件事要注意,如果您的范围包含损坏的链接,则 sheet 的计算将失败,我的代码不会通知您。
这为您增加了另一个选项,但比第一个答案风险更大。没有什么比选择更好的了。 :-)
例如。我希望我的简介 sheet "Main Sheet" 可以选择在不同货币之间切换工作簿。美元和迪拉姆汇率为 3.68。有些单元格引用了不同 sheet 中的其他单元格,所以我不想更改单元格引用,我只需要计算每个 sheet 中特定单元格的速率。
我怎样才能最好地使用复选框或按钮来完成此操作,以便从一开始就轻松转换。我将 excel 用于 Mac。谢谢
创建一个带有验证下拉列表的单元格,允许在 AED 和 USD 之间进行选择。将该单元格转换为命名范围,以便在整个工作簿中轻松引用。您可以将其称为 "Curr","Currency" 的缩写(简称,因为它会经常使用)。
我建议您在输入汇率的地方创建一个类似的单元格,目前为 3.68,但计划仅更改该单元格中的汇率并将其应用于所有工作簿。将该单元格命名为 "Rate".
现在所有包含您可能想要切换的值的单元格都将遵循以下公式。 =[CellValue] * IF(Curr = "AED", Rate, 1)
。此公式假定所有值均以美元输入。如果将它们输入 AED,则公式应如下所示。 = ROUND([CellValue] / IF(Curr = "AED", 1, Rate), 2)
如您所见,此解决方案需要将原始单元格值记录在某处,这意味着用于数据捕获的单元格不能与用于数据显示的单元格相同。如果您希望坚持在同一个单元格中捕获和显示,则需要代码来进行转换。
从表面上看,这似乎很简单:当 Curr
选择更改时,所有具有受影响值的单元格都会重新计算。在实践中,这将以灾难告终,因为有 1001 种方式可能会出错,然后您将丢失所有数据,而不知道此时值是美元还是 AED。
因此,出发点需要是将数据捕获和数据显示分开。一旦完成,工作表函数可能不仅是实现您想要的最简单而且最有效的方法。
我假设您想对输入单元格进行转换,并且并非所有单元格都是公式,并且您要转换的许多单元格都是值。您应该认真考虑将输入与显示分开的答案,这将更加万无一失,并且不受任何可能破坏您的工作簿的逻辑的影响。
如果您热衷于此,请执行以下操作,但是,在您执行之前... 备份您的工作簿。我用以下代码完成的任何测试都没有中断,但我没有你的工作簿,因此,我不做任何保证。
首先,您需要一个显示当前汇率的单元格。您需要为该单元格指定 ExchangeRate.
的命名范围在我的工作簿中,该单元格包含一个公式...
=IF(B1="USD",1,3.68)
看起来像这样...
... 并且单元格 B1 附有验证,允许您从 2 种货币 select,AED 或 USD.
您说您希望能够确保只有 select 离子的细胞会被转化。为确保我们仅围栏那些单元格,您需要创建一个命名范围 ON EACH SHEET,其中包含所有这些单元格。
该范围的名称需要称为 CellsToConvert,您可以通过名称管理器来完成。 创建命名范围时,请确保您指定了要为其创建的作品sheet,不要select编辑"Workbook"选项。
...下面显示了我在第一个 sheet 上使用的零星范围。所有彩色单元格都是该范围的一部分。绿色单元格包含值,黄色单元格包含公式。
在一天结束时,这个范围可能很大并且跨越不同的 sheets 但它应该有效。
现在,将以下代码添加到 VBA 编辑器中的 ThisWorkbook 对象中...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim objCell As Range, dblExRate As Double, strFormula As String, objSheet As Worksheet
Dim strNewFormula As String, strOpeningChar As String, bIsFormula As Boolean
Dim objCells As Range, strError As String, strExRateRangeName As String
strExRateRangeName = "ExchangeRate"
dblExRate = Range(strExRateRangeName)
Application.EnableEvents = False
For Each objSheet In Worksheets
On Error Resume Next
strError = ""
Err.Clear
Set objCells = objSheet.Range("CellsToConvert")
strError = Err.Description
On Error GoTo 0
If strError = "" Then
For Each objCell In objCells
strFormula = objCell.FormulaR1C1
bIsFormula = False
' Check to make sure this field contains a formula.
If Left(strFormula, 1) = "=" And objCell.NumberFormat <> "@" Then
bIsFormula = True
End If
If dblExRate = 1 Then
' Base currency selected.
' Check to see if the cell contains a formula, if it does,
' convert it back to a value
If bIsFormula Then
' It's a formula and the cell is not set to text, proces it back
' to its original value, that could still be a formula.
' Remove all of the exchange rate components we would've added as
' a part of this routine.
strNewFormula = Replace(strFormula, ") * " & strExRateRangeName, "")
' Check to see if the formula has changed against the previous statement,
' if it has, then it contained the custom additions, otherwise, it didn't.
If strFormula <> strNewFormula Then
strNewFormula = Mid(strNewFormula, 3)
' Check to see if the new value is numeric, if it is, remove the leading
' equals sign as it wasn't originally a formula, or, at least it doesn't
' need to be a formula.
If IsNumeric(strNewFormula) Then
objCell.Value = strNewFormula
Else
objCell.FormulaR1C1 = "=" & strNewFormula
End If
End If
End If
Else
' Something other than the base currency has been selected.
strNewFormula = objCell.FormulaR1C1
If InStr(1, strNewFormula, strExRateRangeName, vbTextCompare) = 0 Then
If bIsFormula Then strNewFormula = Mid(objCell.FormulaR1C1, 2)
objCell.FormulaR1C1 = "=(" & strNewFormula & ") * " & strExRateRangeName
End If
End If
Next
End If
Next
Application.EnableEvents = True
End Sub
...完成上述所有操作后,它应该适合您。如果工作簿很大,可以测试性能,但这需要您自己检查。
如果您更改了一个单元格并且它在这些范围之一内并且美元货币不是 selected,您将在按 Enter 后看到输入值更改为公式。当您考虑时,这非常简洁,但可能不适合您。
最后一件事要注意,如果您的范围包含损坏的链接,则 sheet 的计算将失败,我的代码不会通知您。
这为您增加了另一个选项,但比第一个答案风险更大。没有什么比选择更好的了。 :-)