Valores correspondentes as linhas no textbox do userform vba

R

Rafael Moraes Santos

New Member
Joined
Sep 15, 2022
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
Bom dia, preciso de uma ajuda para finalizar meu projeto individual de trabalho.

Tenho um formulário de usuário que busca dados de uma planilha e cria os elementos dinamicamente de acordo com o banco de dados. Pois bem a dificuldade que estou buscando ao gerar o mesmo o número do plano conforme a imagem em anexo, o que eu gostaria de buscar somente o valor correspondente a linha ao invés de replicar estes valores.

VBA Code: 
Sub Cabeçario_item()
    'Add Dynamic Label and assign it to object 'Lbl'
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Assign Label Name
    lbl.Caption = "ITEM"
    lbl.Enabled = True
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl.Height = 120
    lbl.Width = 30
    
    'Label Position
    lbl.Left = 0
    lbl.Top = 10
End Sub
Sub Carregartag()

    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim Cabeçário As Integer
    Dim dict As New Scripting.Dictionary
    Dim charArray(1 To 100) As String
    Dim ColHeader As String
    Dim Planos As MSForms.TextBox
    Dim h As Integer
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    l = 0
    B = dict.Keys
    
    For i = 1 To j
        charArray(1) = Worksheets(1).Cells(i)
        dict.Add Worksheets(1).Cells(i, 9), charArray
    Next i

        For k = 1 To j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = 10
        Planos.Left = l + 30
        Planos.Height = 120
        Planos.Width = 30
        Planos.Font.Name = "Vertigo Upright 2 BRK"
        Planos.Font.Size = 11
        Planos.ForeColor = &HFF0000
        Planos.Font.Bold = True
        Planos.MultiLine = True
        Planos.Value = dict.Keys(k - 1)
        l = l + 30
        
    Next k
    
    
    For Cabeçário = 1 To 1
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Assign Label Name
    lbl.Caption = "CONJUNTO"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 100
    
    'Posição do rótulo
    lbl. Esquerda = l + 30
    lbl.Top = 10
    
    l = l + 100
    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "TAREFA"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 100
    
    'Posição do rótulo
    lbl. Esquerda = l + 30
    lbl.Top = 10
    
    l = l + 100
    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "SERVIÇO"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 500
    
    'Posição do rótulo
    lbl. Esquerda = l + 30
    lbl.Top = 10
    
    l = l + 100
    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "TIPO"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 100
    
    'Posição do rótulo
    lbl.Esquerda = 730 + (30 * c)
    lbl.Top = 10

    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "FREQUÊNCIA"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 30
    
    'Posição do rótulo
    lbl.Esquerda = 830 + (30 * c)
    lbl.Top = 10

    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "CUSTO UNITÁRIO"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 100
    
    'Posição do rótulo
    lbl.Esquerda = 860 + (30 * c)
    lbl.Top = 10

    Próximo Cabeçário
    
    Para Cabeçário = 1 a 1
    c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    Set lbl = UserForm1.Planos.Controls.Add("Forms.Label.1")
    
    'Atribuir nome da etiqueta
    lbl.Caption = "TOTAL PERSONALIZADO"
    lbl.Ativado = Verdadeiro
    lbl.BackColor = &H8000000B
    lbl.Font.Name = "Arial"
    lbl.Font.Size = 11
    lbl.TextAlign = fmTextAlignCenter
    lbl.Enabled = False
    lbl.BorderStyle = fmBorderStyleSingle
    lbl.BorderColor = &H80000000
    
    lbl. Altura = 120
    lbl.Largura = 100
    
    'Posição do rótulo
    lbl.Esquerda = 960 + (30 * c)
    lbl.Top = 10

    Próximo Cabeçário

Finalizar Sub
Sub Carregarplanos()
    '' VARIÁVEIS
    Dim i, j, k, h como inteiro
    Dim a, jrow
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 100) como string
    Planos escuros como controle
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    l = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 10)
        dict.Add Worksheets(1).Cells(i, 10), charArray
    Proximo eu
    
    Para jrow = 1 Para j
        Para k = 1 Para j
            Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1")
            Com Planos
            .Top = 20 * jrow + 110
            .Esquerda = 30 * k
            .Altura = 20
            .Largura = 30
            .Font.Name = "Arial"
            .Font.Size = 11
            .TextAlign = fmTextAlignCenter
            .SelectionMargin = False
            .Value = dict.Keys(k - 1)
            Terminar com
        Próximo k
    Próximo jogo
Finalizar Sub
Sub Carregaritem()

    Dim i, j, k, h como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 2)
        dict.Add Worksheets(1).Cells(i, 1), charArray
    Proximo eu
    
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 0
        Planos. Altura = 20
        Planos.Largura = 30
        Planos.Ativado = False
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 12
        Planos.BorderStyle = fmBorderStyleNone
        Planos.BorderColor = &H80000010
        Planos.SelectionMargin = False
        ''Planos.Bloqueado = Verdadeiro
        ''Planos.Font.Bold = Verdadeiro
        ''Planos.ForeColor = &HFF&
        Planos.SpecialEffect = fmSpecialEffectRaised
        Planos.TextAlign = fmTextAlignCenter
        Planos.BackColor = &H8000000B
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregarconjuntos()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 3)
        dict.Add Worksheets(1).Cells(i, 2), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 30 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 100
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregartarefas()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 4)
        dict.Add Worksheets(1).Cells(i, 3), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 130 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 100
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregarserviços()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 5)
        dict.Add Worksheets(1).Cells(i, 4), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 230 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 500
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregartipo()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.ComboBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 6)
        dict.Add Worksheets(1).Cells(i, 5), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.ComboBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 730 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 100
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.AddItem "AUTOMAÇÃO"
        Planos.AddItem "ELÉTRICO"
        Planos.AddItem "LUBRIFICAÇÃO"
        Planos.AddItem "MATRIZARIA"
        Planos.AddItem "MECÂNICO"
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregarfrequência()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 7)
        dict.Add Worksheets(1).Cells(i, 6), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 830 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 30
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.TextAlign = fmTextAlignCenter
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregarcustounitario()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 8)
        dict.Add Worksheets(1).Cells(i, 7), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 860 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 100
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.TextAlign = fmTextAlignCenter
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        Planos.Value = Format(Planos, "R$ ##,##0.00")
        h = h + 20
    Próximo k
    
Finalizar Sub
Sub Carregarcustototal()

    Dim i As Integer
    Dim j como inteiro
    Dim k como inteiro
    Dim dict As New Scripting.Dictionary
    Dim charArray (1 a 1) como string
    Dim ColHeader como String
    Dim Planos As MSForms.TextBox
    Dim h como inteiro
    
    j = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
    h = 0
    B = dict.Keys
    
    Para i = 1 Para j
        charArray(1) = Planilhas(1).Células(i, 9)
        dict.Add Worksheets(1).Cells(i, 8), charArray
    Proximo eu
        
        Dim c como inteiro
        c = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        
        Para k = 1 Para j
        Set Planos = UserForm1.Planos.Controls.Add("Forms.TextBox.1", "Planos")
        Planos.Top = h + 130
        Planos.Esquerda = 960 + (30 * c)
        Planos. Altura = 20
        Planos.Largura = 100
        Planos.Font.Name = "Arial"
        Planos.Fonte.Tamanho = 10
        Planos.TextAlign = fmTextAlignCenter
        Planos.SelectionMargin = False
        Planos.Value = dict.Keys(k - 1)
        Planos.Value = Format(Planos, "R$ ##,##0.00")
        h = h + 20
    Próximo k
    
Finalizar Sub

[/CÓDIGO]
 

Attachments

  • Capturar.PNG
    Capturar.PNG
    41.6 KB · Views: 22

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
You must log in or register to reply here.

Similar threads

L
  • Question Question
Responder apenas ao último e-mail no Outlook do Excel VBA
Replies
0
Views
891
Laucir Miranda
L
R
  • Question Question
Create dynamic textbox by column amount
Replies
0
Views
725
Rafael Moraes Santos
R
B
  • Locked
  • Question Question
Userform Dynamically Fill and Create Textbox
Replies
1
Views
2K
Fluff
Fluff
B
  • Question Question
Dynamically Create and Fill Value of Userform Textbox in VBA
2
Replies
10
Views
22K
Fluff
Fluff
K
  • Solved
Add multiple values from userform and table to single cell VBA
Replies
4
Views
2K
KestutisTower
K

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top