Question

这些是Excel工作表中的A，B和C列。

如果A栏中的中间帐号为＆gt; = 40000且＆lt; 60000则则实际金额为值应乘以-1。什么VB代码这样做？

Account Number    Account Description      Actual Amount

10-40100-400    Contributions - Support    ($12,843.63)
10-53450-400    Rental Income              ($9,584.60)
10-53500-400    Housing Income             ($67,933.38)
10-54900-400    Miscellanous Revenue       ($2,615.56)
10-72100-400    Salary and Wages            $43,378.11 
10-72100-420    Salary and Wages            $607.91 
10-72400-400    Health Insurance            $14,843.94 
10-72440-400    Life Insurance              $286.62 
10-72500-400    FICA Expense                $3,283.73 
10-72500-420    FICA Expense                $46.50 
10-75400-400    Professional Services       $9,392.28 
10-81100-400    Office Supplies             $3,754.16 
10-81300-400    Telephone                   $540.00 
10-82110-400    Furnishings and Equipment   $6,186.20 
10-82140-400    Maintenance & Repair-Equi   $4,658.21 
10-82160-400    Maintenance & Repair-Buil   $13,576.61 
10-82200-400    Utilities                   $35,467.33 
10-82600-400    Vehicle Expenses            $196.18 
10-83100-400    Meals and Entertainment     $10.83 
10-83140-400    Travel                      $34.84 
10-85240-400    Prop/Casualty Insurance     $22,535.60 
10-85260-400    Auto Insurance              $691.47 
10-85300-400    Dues and Subscriptions      $145.00 
10-85980-400    Miscellaneous Expense      ($45.00)
10-86500-400    Permits and Licenses        $1,010.00 
10-99150-400    Ministry Grant Transfers    $32,249.97 
10-99200-400    Ministry Transfers         ($8,992.44)
20-72100-400    Salary and Wages            $0.00 
Totals for 71500:                           $0.00 

Grand Totals:                               $0.00

我已尝试将A列复制到D列，然后将其修剪为数字。

然后使用if语句进行反向。

lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A15:A" & lastrow).Copy Range("D15")
Dim rng As Range
Dim rngsear As Range
Set rng = Range("D15:D" & lastrow)
For Each rng In Selection
rng = Mid(rng, 4, 5)
Next rng
With ActiveSheet
     lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
     Set rng = .Range("D15:D" & lastrow)
     Set rngsear = .Range("C15:C" & lastrow)
     rngsear.Value = .Evaluate("IF((" & rng.Address & " >= 40000)*(" & rng.Address & " < 60000)," & rngsear.Address & " * -1," & rngsear.Address & ")")
End With

但它与之前用于获取3列的代码冲突。

Dim sSheetName As String
Dim sDataRange As String
sSheetName = ActiveSheet.Name
sDataRange = Selection.Address
Range("C9:F9").Select
Selection.Cut Destination:=Range("D9:G9")
Range("C:C,D:D,F:F,G:G").Select
Range("G1").Activate
Selection.Delete Shift:=xlToLeft
    Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A15:C" & lastrow).Sort key1:=Range("A15:A" & lastrow), _
order1:=xlAscending, Header:=xlNo

这是最好的方法吗？

Answer 1

看看下面的内容，看看它是否有帮助。

Sub Check()

Dim str_extract As String
Dim lastrow As Integer


lastrow = Cells(Rows.Count, 2).End(xlUp).Row

For x = 1 To lastrow

    If (Right(Left(Cells(x, 1).Value, 8), 5) >= 40000 And Right(Left(Cells(x, 1).Value, 8), 5) < 60000) _
    Then Cells(x, 3).Value = Cells(x, 3).Value * -1

Next x

MsgBox "Done"

End Sub

Answer 2

使用Mid从A列中的值中获取5位数帐号，然后使用Val将其转换为数字。然后，您可以执行＆gt; = 40000和＆lt; = 60000检查，并在需要时将余额乘以-1。一旦知道了余额，就可以简单地设置D列的值。

Option Explicit

Sub ConvertBalance()
    Dim ws As Worksheet
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim lngAccountNumber As Long
    Dim lngBalance As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
    lngLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    For lngRow = 2 To lngLastRow '<-- change start row if you need to
        lngAccountNumber = Val(Mid(ws.Cells(lngRow, 1).Value, 4, 5))
        lngBalance = ws.Cells(lngRow, 3).Value
        If lngAccountNumber >= 40000 And lngAccountNumber <= 60000 Then
            lngBalance = lngBalance * -1
        End If
        ws.Cells(lngRow, 4) = lngBalance
    Next lngRow

End Sub

如果您只想在使用VBA插入的D列中使用公式，则可以使用以下公式：

=C2*IF(AND(VALUE(MID(A2,4,5))>=40000,VALUE(MID(A2,4,5))<=60000),-1,1)

在代码中它是：

选项明确

Sub ConvertBalance2()
    Dim ws As Worksheet
    Dim lngLastRow As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
    lngLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    With ws.Range("D2:D" & lngLastRow)
        .Formula = "=C2*IF(AND(VALUE(MID(A2,4,5))>=40000,VALUE(MID(A2,4,5))<=60000),-1,1)"
    End With

End Sub

VBA vlookup用于字符串中的值和反向

2 个答案: