Question

所以，我有一堆需要用字母代替的列，这是旧的签名过量的东西。所以基本上我想做的是用数字替换字母，然后将每个单元格乘以0.02。

但是我想这样做，所以我可以指定I范围，然后在新的工作表中输出这个新信息。

所以基本上，我会有一个像这样的专栏 1. 0000012C = 00000123 x 0.02 = 2.46 2. 0002927B = 29272 x 0.02 = 585.44

Private Sub CommandButton1_Click()
Dim OriginalText As String
Dim CorrectedText As String

OriginalText = Range("A1:D15").Value

CorrectedText = Replace(OriginalText, "A", "1")
CorrectedText = Replace(OriginalText, "B", "2")
CorrectedText = Replace(OriginalText, "C", "3")
CorrectedText = Replace(OriginalText, "D", "4")
CorrectedText = Replace(OriginalText, "E", "5")
CorrectedText = Replace(OriginalText, "F", "6")
CorrectedText = Replace(OriginalText, "G", "7")
CorrectedText = Replace(OriginalText, "H", "8")
CorrectedText = Replace(OriginalText, "I", "9")
CorrectedText = Replace(OriginalText, "{", "0")
CorrectedText = Replace(OriginalText, "}", "-0")

Worksheets("Sheet1").Range("F1:I15").Value = CorrectedText
End Sub

这是我到目前为止所做的，但我认为我没有正确地做到这一点，任何在excel中有更多vb经验的人都可以看看。

Answer 1

有几件事。

您需要使用For Each循环单独遍历每个单元格。
无需更正文字。只需保留原始文本中的值即可。你拥有它的方式将用每个新行替换校正的文本，这样唯一一个将显示的是最后一个，通过使用原始文本，它只保存每次替换的更改。

使用offset将值放入正确的单元格中。

Dim OriginalText As String
Dim cell As Range
Dim aws As Worksheet
Dim dws As Worksheet

Set aws = ActiveSheet
Set dws = ActiveWorkbook.Sheets("Sheet1")
For Each cel In aws.Range("A1:D15")
    OriginalText = cel.value
    OriginalText = Replace(OriginalText, "A", "1")
    OriginalText = Replace(OriginalText, "B", "2")
    OriginalText = Replace(OriginalText, "C", "3")
    OriginalText = Replace(OriginalText, "D", "4")
    OriginalText = Replace(OriginalText, "E", "5")
    OriginalText = Replace(OriginalText, "F", "6")
    OriginalText = Replace(OriginalText, "G", "7")
    OriginalText = Replace(OriginalText, "H", "8")
    OriginalText = Replace(OriginalText, "I", "9")
    OriginalText = Replace(OriginalText, "{", "0")
    OriginalText = Replace(OriginalText, "}", "-0")
    dws.Range(cel.Address).Offset(, 5) = OriginalText
Next cel

如果您希望在将每个数字放入新单元格时进行相乘，请更改此行：

        dws.Range(cel.Address).Offset(, 5) = OriginalText

为：

        dws.Range(cel.Address).Offset(, 5) = OriginalText * .01

Answer 2

Saad的，

以下代码适合您。

Private Function DoReplace(Text As String) As String
    Dim ReplacedValue As String
    ReplacedValue = Text

    ReplacedValue = Replace(ReplacedValue, "A", "1")
    ReplacedValue = Replace(ReplacedValue, "B", "2")
    ReplacedValue = Replace(ReplacedValue, "C", "3")
    ReplacedValue = Replace(ReplacedValue, "D", "4")
    ReplacedValue = Replace(ReplacedValue, "E", "5")
    ReplacedValue = Replace(ReplacedValue, "F", "6")
    ReplacedValue = Replace(ReplacedValue, "G", "7")
    ReplacedValue = Replace(ReplacedValue, "H", "8")
    ReplacedValue = Replace(ReplacedValue, "I", "9")
    ReplacedValue = Replace(ReplacedValue, "{", "0")
    ReplacedValue = Replace(ReplacedValue, "}", "-0")

    DoReplace = ReplacedValue
End Function

Private Sub CommandButton1_Click()
    Dim Text As String, CalculatedValue As Double

    For Each cell In Worksheets("Sheet1").Range("A1:D15").Cells
        If cell.Value <> "" Then
            Text = DoReplace(cell.Value)
            CalculatedValue = Val(Text) * 0.02
            Worksheets("Sheet2").Cells(cell.Row, cell.Column).Value = CalculatedValue
        End If
    Next

End Sub

上面的代码将执行所有替换和计算，并将最终输出放在 Sheet2 相同的行中。

Answer 3

此版本执行整个范围的替换：

Option Explicit

Private Sub CommandButton1_Click()

    replaceLetters Worksheets("Sheet1").Range("A1:D15")

End Sub

Private Sub replaceLetters(ByRef rng As Range, Optional ByVal offsetCol As Long = 1)

    Const RELACEMENTS   As String = "A1 B2 C3 D4 E5 F6 G7 H8 I9 {0 }-0"
    Const TIMES         As String = " x 0.02"

    Dim newRng As Range, replVals As Variant, rv As Variant

    replVals = Split(RELACEMENTS)

    Application.ScreenUpdating = False

    Set newRng = rng.Offset(0, rng.Column + rng.Columns.Count + (offsetCol - 1))

    newRng.Value2 = rng.Value2  'copy values to the offset range

    For Each rv In replVals
        With newRng
            .Replace What:=Left(rv, 1), Replacement:=Right(rv, Len(rv) - 1) & TIMES, _
                     LookAt:=xlPart
        End With
    Next

    newRng.EntireColumn.AutoFit

    Application.ScreenUpdating = True
End Sub

在VBA excel中替换功能

3 个答案: