VBA vlookup 查找字符串中的值及其逆值

Question

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

如果 A 列中间的帐号 >=40000 且 <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