VBA查找string中的值和逆
这些是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
什么是最好的方法来做到这一点？
看看下面，看看是否有帮助。
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
使用Mid从列A中的值获取5位数帐号，并使用Val将其转换为数字。 然后，您可以执行> = 40000和<= 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