需要在vba中简化vlookup命令的文本框值

我想创build700个texboks，其值是从vlookup vb函数中获取的。 但达到300后，我可以警告过多的程序。

Private Sub Extra_Change() Dim ycNo As Integer If Me.NumberLook.Value = "" Then MsgBox "bla..bla..bla!!!", vbExclamation, "some text" Exit Sub End If ycNo = NumberLook.Value Me.TextBox1.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 3, 0) Me.TextBox2.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 4, 0) Me.TextBox3.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 5, 0) Me.TextBox4.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 6, 0) Me.TextBox5.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 7, 0) Me.TextBox6.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 8, 0) Me.TextBox7.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 9, 0) Me.TextBox8.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 10, 0) Me.TextBox9.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 11, 0) Me.TextBox10.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 12, 0) Me.TextBox11.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 13, 0) Me.TextBox12.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 14, 0) Me.TextBox13.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 15, 0) Me.TextBox14.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 16, 0) Me.TextBox15.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 17, 0) Me.TextBox16.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 18, 0) Me.TextBox17.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 19, 0) Me.TextBox18.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 20, 0) Me.TextBox19.Value = Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), 21, 0) ... ... ... to 700 

也许有人可以解决这个问题..

Answer 1

只要实现一个循环：

 Private Sub cmbNourut_Change() Dim ycNo As Integer Dim i As Long If Me.cmbNourut.Value = "" Then MsgBox "bla..bla.bla!!!", vbExclamation, "...." Exit Sub End If ycNo = cmbNourut.Value For i = 1 To 700 Me.Controls("TextBox" & i).Value = _ Application.WorksheetFunction.VLookup(ycNo, Worksheets("mapel1").Range("A1:AAX55"), i + 2, 0) Next i End Sub 

Answer 2

1-因为所有你正在抓取的物品都属于同一行，取一次，不要叫VLookup 700次！

2-获取数组中的行值

3-控制循环，并从数组中分配它们

 Private Sub cmbNourut_Change() ... ycNo = NumberLook.value ' 1- Find the row by matching in column A Dim r: r = Application.Match(ycNo, Worksheets("mapel1").Range("A1:A55"), 0) If IsError(r) Then MsgBox ("not found blablah"): Exit Sub ' 2- Get the array of values from the found row starting at column C Dim ar: ar = Worksheets("mapel1").Cells(r, 3).Resize(, 700).Value2 '3- Loop and assign text-boxes from the array Dim i as Long For i = 1 To 700 Me.Controls("TextBox" & i).value = ar(i) Next End Sub