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

我想創建700個texboks，其值取自vlookup vb函數。但達到300後，我可以警告過多的程序。需要在vba中簡化vlookup命令的文本框值

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

也許有人能解決這個問題..

來源

2017-06-19 Yan LimaBenua

太多了，我認爲這可能是一點點縮短 –

只實現一個循環：

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

來源

2017-06-19 18:27:45 BruceWayne

謝謝你..問題結束了。要停止循環功能？ –

@YanLimaBenua - 你是什麼意思？你如何停止循環？您可以添加'Exit For'退出循環。你是這個意思嗎？所以，假設你想在條件是我之後停止循環。在'For i = 1 ...'循環中，你可以添加'If i = 500 Then Exit For'。 – BruceWayne

是的，沒錯。我已經測試了上面的公式，並且一切順利。謝謝bro –

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

來源

2017-06-19 18:39:29

你的解決方案很有幫助。謝謝 –

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

回答

相關問題