УВА вставив значения на основе другого столбца

Question

мне нужна помощь в создании макроса, который помогает мне вставить значение в новой колонке я создал

К примеру у меня есть 3 страны, Бельгия (БГД), Швейцария (BHS) и Англия (ENG) в колонке B. И если значение в столбце B является BGD, новый столбец должен вставить значение 8261 и для Швейцарии, его 8159.

Это то, что я пробовал. Спасибо.

Sub Entities() 
Dim Found As Range 
Dim LR As Long 
Dim ws As Worksheet 
Dim rng As Range 
Dim Lrow As Long 
Dim cell As Range 


Set ws = Sheets("Europe") 

Set Found = Rows(1).Find(what:="Total Amount in Foreign Currency", LookIn:=xlValues, lookat:=xlWhole) 
If Found Is Nothing Then Exit Sub 
LR = Cells(Rows.Count, Found.Column).End(xlUp).Row 
Found.Offset(, 1).EntireColumn.Insert 
Cells(1, Found.Column + 1).Value = "Entities" 

Set rng = Range("B2:B127") 
Select Case rng 
    Case "BGD" 
    Range(Cells(2, Found.Column + 1), Cells(LR, Found.Column + 1)).Value = 8261 

    Case "BHS" 
    Range(Cells(2, Found.Column + 1), Cells(LR, Found.Column + 1)).Value = 8159 
    Case "ENG" 
    Range(Cells(2, Found.Column + 1), Cells(LR, Found.Column + 1)).Value = 8550 

    End Select  
End Sub 

Answer 1

Sub Entities() 

    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("Europe") 

    Set Found = ws.Rows(1).Find(what:="Total Amount in Foreign Currency", _ 
           LookIn:=xlValues, lookat:=xlWhole) 
    If Found Is Nothing Then Exit Sub 

    a = [{"BGD",8261;"BHS",8159;"ENG",8550}] '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 = "Entities" 

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

End Sub 

Answer 2

Может быть, цикл будет работать для вас

Dim i as Integer 
i=2 

For i=2 to i=127 

If Instr(1,ActiveSheet.Range("B" & i & "").Value>0,"BGD") Then 
ActiveSheet.Range("C" & i & "").Value = "8261" 
End If 
If Instr(1,ActiveSheet.Range("B" & i & "").Value>0,"BHS") Then 
ActiveSheet.Range("C" & i & "").Value = "8159" 
End If 
If Instr(1,ActiveSheet.Range("B" & i & "").Value>0,"ENG") Then 
ActiveSheet.Range("C" & i & "").Value = "8550" 
End If 

Next i