Question

我需要帮助创建一个宏来帮助我在我创建的新列中插入值

例如，我在B列中有3个国家，比利时（BGD），瑞士（BHS）和英格兰（ENG）。如果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

也许for循环对你有用

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

Answer 2

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

vba基于另一列插入值

2 个答案: