创建新列并根据另一列插入值

时间:2015-01-27 05:24:05

标签: excel vba excel-vba

我需要帮助。

目前我需要优化代码和流程的方式。我有另一种方法可以做到这一点吗?区分值的唯一方法是第一个到数字。并且有超过一百个值。正如您在代码中看到的那样,99将分配值1042,95将分配261,这将继续。如何让它变得更容易,以便我必须手动输入值。谢谢你们提前

Sub Netting()

 Dim Found As Range
 Dim LR As Long
 Dim ws As Worksheet
 Dim cell As Range
 Dim a As Variant, v As Variant

 Set ws = Sheets("PAYABLES - OUTFLOWS")

 Set Found = ws.Rows(1).Find(What:="Invoice amount", _
                            LookIn:=xlValues, lookat:=xlWhole)
 If Found Is Nothing Then Exit Sub

 a = [{"HI99162152",1042;"HI99162159",1042;"99162161",1042;"HI95400159",261; "HI95400164", 261; "HI97500493",3004;"HI97500497", 3004 }] 'create 2-d lookup array

    LR = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
 Found.Offset(0, 1).EntireColumn.Insert
 ws.Cells(1, Found.Column + 1).Value = "Netting"

    For Each cell In ws.Range(ws.Range("C2"), ws.Cells(LR, 3))
    v = Application.VLookup(cell.Value, a, 2, False)
    cell.EntireRow.Cells(Found.Column + 1).Value = IIf(IsError(v), "", v)
    Next cell

End Sub

1 个答案:

答案 0 :(得分:0)

Sub Netting()

     Dim Found As Range
     Dim LR As Long
     Dim ws As Worksheet
     Dim cell As Range
     Dim a As Variant, v As Variant, num

     Set ws = Sheets("PAYABLES - OUTFLOWS")

     Set Found = ws.Rows(1).Find(What:="Invoice amount", _
                                LookIn:=xlValues, lookat:=xlWhole)
     If Found Is Nothing Then Exit Sub

     a = [{"99",1042;"95",261;"97",3004}] 'create 2-d lookup array

     LR = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
     Found.Offset(0, 1).EntireColumn.Insert
     ws.Cells(1, Found.Column + 1).Value = "Netting"

     For Each cell In ws.Range(ws.Range("C2"), ws.Cells(LR, 3))
        num = Cstr(Mid(cell.Value, 3, 2))
        v = Application.VLookup(num, a, 2, False)
        cell.EntireRow.Cells(Found.Column + 1).Value = IIf(IsError(v), "", v)
     Next cell

End Sub

如果您的数组中有大量值,则可能更容易将其作为工作表上的表进行管理。