excel - 如何使用户表单完成另一个用户表单？

Question

我有一个用户表单，有两个组合框。其中一个包含零件编号，另一个包含零件描述，例如：

零件编号：01982391823

描述：5/8" Festo 阀门

他们都有来自另一张表（数据库）的项目。

我想做的是，如果我把代码放在代码组合框中，另一个给我显示相应的描述，反之亦然（因为它们大约有 400 项）。那可能吗？

编辑：

在“Love Coding”和改编的帮助下，我插入了您的代码：

'from here starts the macro test, to see if it can search the code by text and vice versa

Private Sub ComboBox2_Change()

Dim WS As Worksheet
Dim LastRow As Long
Dim aCell As Range
Set WS = Planilha3

If ComboBox2.Value <> "" Then
    'LOOP THRU ALL THE DATABASE AND LOOK FOR THE DESC ROW NUMBER AND GET THE PART
        For a = 2 To WS.Range("C" & Rows.Count).End(xlUp).Row
        If CStr(WS.Range("C" & a).Value) = ComboBox2.Value Then
            ComboBox3.Value = WS.Range("B" & a).Value
            Exit For
        End If
    Next a
End If


End Sub

Private Sub ComboBox3_Change()

Dim WS As Worksheet
Dim LastRow As Long
Dim aCell As Range
Set WS = Planilha3

If ComboBox3.Value <> "" Then
    'LOOP THRU ALL THE DATABASE AND LOOK FOR THE PART ROW NUMBER AND GET THE DESC
    For a = 2 To WS.Range("B" & Rows.Count).End(xlUp).Row
        If CStr(WS.Range("B" & a).Value) = ComboBox3.Value Then
            ComboBox2.Value = WS.Range("C" & a).Value
            Exit For
        End If
    Next a
End If
'daqui fecha a primeira parte do código que procura de acordo com a descrição, ele continua no "initialize"
'from here ends the macro test, to see if it can search the text by code and vice versa
End Sub



Private Sub CommandButton1_Click()

'trecho para ir para selecionar a ultima linha em branco da tabela
    Dim linha As Integer
    linha = Planilha1.Range("A1048576").End(xlUp).Row + 1


'colando as informações do formulário no banco

    'data
    Planilha1.Range("A" & linha) = TextBox1.Text
    'código
    Planilha1.Range("B" & linha) = ComboBox2.Text
    'item (descrição)
    Planilha1.Range("C" & linha) = ComboBox3.Text
    'quantidade
    Planilha1.Range("D" & linha) = TextBox4.Text * (-1)
    'usuário
    Planilha1.Range("U" & linha) = ComboBox1.Text



End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub CommandButton3_Click()

'botão cancelar (nunca colocar ponto entre unload e me)
Unload Me

End Sub

Private Sub Label3_Click()

End Sub

Private Sub TextBox1_Change()

'permitindo apenas 10 caracteres (2 da data, 2 do mes, 4 do ano, 2 barras)
TextBox1.MaxLength = 10

'condição pra depois do dia e do mês ele escrever a barra automático
    If Len(TextBox1) = 2 Or Len(TextBox1) = 5 Then
        TextBox1.Text = TextBox1.Text & "/"
    End If


End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

'proibir colocação de caractere fora numeros
    If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
        KeyAscii = 0
    End If


End Sub

Private Sub TextBox4_Change()



End Sub

Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

'proibir colocação de caractere fora números
    If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
        KeyAscii = 0
    End If


End Sub

Private Sub UserForm_Initialize()

'campo usuário

'colocando itens a serem exibidos no combobox "usuário"
'private sub Userform_initialize ()
'ComboBox.AddItem "item a ser adicionado"
ComboBox1.AddItem "DEMETRIUS RABELO"
ComboBox1.AddItem "ERIC SANTOS"
ComboBox1.AddItem "GERALDO GUIMARÃES"
ComboBox1.AddItem "REGINALDO SILVA"

    'campo código
    'puxando os códigos existentes na planilha
    'ComboBox2.List = Planilha3.Range("B:B").Value

'campo código

'apenas mostrando valores não vazios no campo código
Dim WS As Worksheet
Dim LastRow As Long
Dim aCell As Range
Set WS = Planilha3

'deixando a planilha vazia
WS.Visible = False

With WS
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For Each aCell In .Range("B2:B" & LastRow)
        If aCell.Value <> "" Then
            Me.ComboBox2.AddItem aCell.Value
        End If
    Next
End With

'campo item

With WS
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    For Each aCell In .Range("C2:C" & LastRow)
        If aCell.Value <> "" Then
            Me.ComboBox3.AddItem aCell.Value
        End If
    Next
End With

' continuation:

'ADD ITEMS TO COMBOBOX PART
With ComboBox2
    'Loop thru all the parts and add to the combobox part
    For a = 2 To WS.Range("B" & Rows.Count).End(xlUp).Row
        ComboBox2.AddItem WS.Range("B" & a).Value
    Next a
End With


'ADD ITEMS TO COMBOBOX DESCRIPTION
With ComboBox3
'Loop thru all the description and add to the combobox description
    For b = 2 To WS.Range("C" & Rows.Count).End(xlUp).Row
        ComboBox3.AddItem WS.Range("C" & b).Value
    Next b
End With

End Sub

我已经在开头添加了 Dim 部分，以避免宏中出现“错误 424”，但是我还不能做我想做的事

我添加了一张图片来澄清。在葡萄牙语中，“CÓDIGO”是组合框 2，即代码空间。“ITEM”是描述（combobox3）。

标签： excelvba

Answer 1

试试下面的代码，我假设您的部件号位于 A 列，描述位于 B 列。

组合框部件名称：cbo_part，组合框描述名称：cbo_desc

Dim mySh As Worksheet


Private Sub cbo_desc_Change()

If cbo_desc.Value <> "" Then
    'LOOP THRU ALL THE DATABASE AND LOOK FOR THE DESC ROW NUMBER AND GET THE PART
    For a = 2 To mySh.Range("B" & Rows.Count).End(xlUp).Row
        If CStr(mySh.Range("B" & a).Value) = cbo_desc.Value Then
            cbo_part.Value = mySh.Range("A" & a).Value
            Exit For
        End If
    Next a
End If
End Sub

Private Sub cbo_part_Change()

If cbo_part.Value <> "" Then
    'LOOP THRU ALL THE DATABASE AND LOOK FOR THE PART ROW NUMBER AND GET THE DESC
    For a = 2 To mySh.Range("A" & Rows.Count).End(xlUp).Row
        If CStr(mySh.Range("A" & a).Value) = cbo_part.Value Then
            cbo_desc.Value = mySh.Range("B" & a).Value
            Exit For
        End If
    Next a
End If
End Sub

Private Sub UserForm_Initialize()

Set mySh = ThisWorkbook.Sheets("Sheet1") 'name of your worksheet database

'ADD ITEMS TO COMBOBOX PART
With cbo_part
    'Loop thru all the parts and add to the combobox part
    For a = 2 To mySh.Range("A" & Rows.Count).End(xlUp).Row
        cbo_part.AddItem mySh.Range("A" & a).Value
    Next a
End With


'ADD ITEMS TO COMBOBOX DESCRIPTION
With cbo_desc
'Loop thru all the description and add to the combobox description
    For b = 2 To mySh.Range("B" & Rows.Count).End(xlUp).Row
        cbo_desc.AddItem mySh.Range("B" & b).Value
    Next b
End With

End Sub