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 

Answer 2

使用Mid列Aの値から5桁の口座番号を取得し、数に変換するValを使用します。次に、> = 40000と< = 60000をチェックし、必要に応じて残高に-1を掛けます。あなただけの列Dで数式を使用する場合は、VBAで挿入されたあなたは、単に

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 

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