none
Resultado de 2 rotinas em Listbox. RRS feed

  • Pergunta

  • Boa tarde.

    Pretendo preencher 4 colunas de uma Listbox da segunte forma:

    Col1 - strings da coluna L

    Col2 - Quantidade de vezes que se repete cada string da coluna L

    Col3 - string da Coluna K

    Col4 - Quantidade de vezes que se repete cada string da coluna K.

    Estou tentando resolver com as seguintes rotinas:

    A rotina seguinte, tenta obter os dados da coluna L, incrementando a variável em cada ciclo.

    Private Sub ReferencServ()
     Dim lng As Long
      Dim strServ As String
      Dim TotServ As Integer
      
      Set mwksDados = ThisWorkbook.Worksheets("DADOS")
      Set mclcServ = New Collection
      
      With mwksDados
        On Error Resume Next
        For lng = 1 To .Cells(.Rows.Count, "L").End(xlUp).Row
          strServ = .Cells(lng, "L").Value
          mclcServ.Add strServ, strServ
       TotServ = strServ + 1
       
        Next lng
        On Error GoTo 0
      End With
    
    End Sub

    Na rotina seguinte, repete-se a mesma situação, mas para a coluna K.

    Private Sub Referenc()
     Dim lng As Long
      Dim strRef As String
      Dim TotRef As Integer
      
      Set mwksDados = ThisWorkbook.Worksheets("DADOS")
      Set mclcRef = New Collection
      
      With mwksDados
        On Error Resume Next
        For lng = 1 To .Cells(.Rows.Count, "K").End(xlUp).Row
          strRef = .Cells(lng, "K").Value
          mclcRef.Add strRef, strRef
       TotRef = strRef + 1
        Next lng
        On Error GoTo 0
      End With
    
    End Sub

    Na terceira rotina e que se segue, tenta-se gravar nas colunas da Listbox as variáveis obtidas nas duas primeiras rotinas.

    Private Sub CheckBox9_Click()
    Dim lng As Long
    Dim strServ As String
    Dim strRef As String
    Dim TotServ As Integer
    Dim TotRef As Integer
    
      Me.ListBox5.Clear
      For lng = 1 To mclcServ.Count
        strServ = VBA.UCase(mclcServ(lng))
    Referenc
        strRef = VBA.UCase(mclcRef(lng))
    With Me.ListBox5
    .ColumnCount = 4
    ListBox5.ColumnWidths = "150;60;150;50"
    
    .AddItem
    .List(.ListCount - 1, 0) = strServ
    .List(.ListCount - 1, 1) = TotServ
    .List(.ListCount - 1, 2) = strRef
    .List(.ListCount - 1, 3) = TotRef
    
        End With
      Next lng
    
    End Sub

    Ao executar, apresenta erro na linha sublinhada, "Runtime error 9" " Subscrpt Out of Range".

    Precisava pois de uma solução para este código.

    Antecipadamente grato

    Cumprimentos

    M_A_L




    • Editado M_A_S_L terça-feira, 7 de janeiro de 2014 17:29
    terça-feira, 7 de janeiro de 2014 15:53

Respostas

  • Manuel,

    Avaliando melhor o problema, creio que o objeto Collection não será adequado para te dar os totais de cada item. Nesse caso, é melhor utilizar o objeto Dictionary. Veja o exemplo a seguir:

    Private Sub UserForm_Initialize()
      Dim wks As Excel.Worksheet
      
      Set wks = ThisWorkbook.Worksheets("Plan1")
      fncPopulateListBox Me.ListBox5, wks.Columns("K")
      fncPopulateListBox Me.ListBox6, wks.Columns("L")
    End Sub
    
    Private Sub fncPopulateListBox(lbo As MSForms.ListBox, rngCol As Excel.Range)
      Dim lngCol As Long
      Dim dic As Object ' Scripting.Dictionary
      Dim lng As Long
      Dim lngRow As Long
      Dim lngLast As Long
      Dim str As String
      Dim var As Variant
      Dim wks As Excel.Worksheet
      
      Set dic = CreateObject("Scripting.Dictionary")
      lngCol = rngCol.Column
      Set wks = rngCol.Parent
      With wks
        lngLast = .Cells(.Rows.Count, lngCol).End(xlUp).Row
        For lngRow = 2 To lngLast
          str = .Cells(lngRow, lngCol).Value
          If Len(str) > 0 Then
            If dic.Exists(str) Then
              dic(str) = dic(str) + 1
            Else
              dic.Add str, 1
            End If
          End If
        Next lngRow
      End With
    
      With lbo
        .ColumnCount = 2
        For Each var In dic.Keys
          .AddItem
          .List(.ListCount - 1, 0) = var
          .List(.ListCount - 1, 1) = dic(var)
        Next var
      End With
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:12
    quinta-feira, 9 de janeiro de 2014 01:03
    Moderador
  • Estou assumindo que mclcServ e mclcRev são variáveis de nível de módulo.

    Sugiro fazer algo como:

    Private Sub UserForm_Initialize()
      Call ReferencServ
      Call Referenc
    End Sub
    

    E a terceira rotina que você apresentou como:

    Private Sub CheckBox9_Click()
      Dim lng As Long
      Dim strServ As String
      Dim strRef As String
      Dim TotServ As Integer
      Dim TotRef As Integer
      
      Me.ListBox5.Clear
      For lng = 1 To mclcServ.Count
        strServ = VBA.UCase(mclcServ(lng))
        strRef = VBA.UCase(mclcRef(lng))
          
        With Me.ListBox5
          .ColumnCount = 4
          ListBox5.ColumnWidths = "150;60;150;50"
          
          .AddItem
          .List(.ListCount - 1, 0) = strServ
          .List(.ListCount - 1, 1) = TotServ
          .List(.ListCount - 1, 2) = strRef
          .List(.ListCount - 1, 3) = TotRef
        End With
      Next lng
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:13
    terça-feira, 7 de janeiro de 2014 21:17
    Moderador
  • Sobre variáveis de nível de procedimento, de módulo e globais: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/#variaveis_locais_e_variaveis_globais

    ---

    Estou estranhando algo na sua rotina. Você está fazendo um laço em que a variável de controle percorre os itens da coleção mclcServ, mas está acessando itens da coleção mclcRef. Isso pode dar erro porque se a coleção mclcServ for maior que mclcRef, você obterá um erro de execução ao tentar acessar um item cujo índice da coleção mclcRef extrapole sua quantidade de itens.

    Logo, você precisará de duas caixas de listagem para ver os seus dois resumos de contagem: uma para a coleção mclcServ e outra para a coleção mclcRef.

    Você poderia fazer algo como mostrado a seguir, mas deve criar uma caixa de listagem extra para a coleção mclcRef chamada ListBox6:

    Private Sub CheckBox9_Click()
      Dim lng As Long
      Dim strServ As String
      Dim strRef As String
      Dim TotServ As Integer
      Dim TotRef As Integer
      
      With Me.ListBox5
        .ColumnCount = 2
        .ColumnWidths = "150;60"
        .Clear
        
        For lng = 1 To mclcServ.Count
          strServ = UCase(mclcServ(lng))
          .AddItem
          .List(.ListCount - 1, 0) = strServ
          .List(.ListCount - 1, 1) = TotServ
        Next lng
      End With
    
      With Me.ListBox6
        .ColumnCount = 2
        .ColumnWidths = "150;60"
        .Clear
        
        For lng = 1 To mclcRef.Count
          strRef = UCase(mclcRef(lng))
          .AddItem
          .List(.ListCount - 1, 0) = strRef
          .List(.ListCount - 1, 1) = TotRef
        Next lng
      End With
    End Sub
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:23
    quarta-feira, 8 de janeiro de 2014 01:18
    Moderador
  • Sim, criei essa função para não precisar escrever uma rotina para o ListBox5 e ListBox6.

    Sobre sua indagação a respeito do rótulo (Label), faça o teste a seguir: crie um formulário com 10 rótulos, chamando-os de Label1 a Label10. Insira o código a seguir na classe do formulário e execute o programa:

    Private Sub UserForm_Initialize()
      Dim lng As Long
      
      For lng = 1 To 10
        Me.Controls("Label" & lng).Caption = "Este é o rótulo " & lng
      Next lng
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sexta-feira, 17 de janeiro de 2014 17:48
    quinta-feira, 9 de janeiro de 2014 22:37
    Moderador

Todas as Respostas

  • Estou assumindo que mclcServ e mclcRev são variáveis de nível de módulo.

    Sugiro fazer algo como:

    Private Sub UserForm_Initialize()
      Call ReferencServ
      Call Referenc
    End Sub
    

    E a terceira rotina que você apresentou como:

    Private Sub CheckBox9_Click()
      Dim lng As Long
      Dim strServ As String
      Dim strRef As String
      Dim TotServ As Integer
      Dim TotRef As Integer
      
      Me.ListBox5.Clear
      For lng = 1 To mclcServ.Count
        strServ = VBA.UCase(mclcServ(lng))
        strRef = VBA.UCase(mclcRef(lng))
          
        With Me.ListBox5
          .ColumnCount = 4
          ListBox5.ColumnWidths = "150;60;150;50"
          
          .AddItem
          .List(.ListCount - 1, 0) = strServ
          .List(.ListCount - 1, 1) = TotServ
          .List(.ListCount - 1, 2) = strRef
          .List(.ListCount - 1, 3) = TotRef
        End With
      Next lng
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:13
    terça-feira, 7 de janeiro de 2014 21:17
    Moderador
  • Estou assumindo que mclcServ e mclcRev são variáveis de nível de módulo.

    Sugiro fazer algo como:

    Private Sub UserForm_Initialize()
      Call ReferencServ
      Call Referenc
    End Sub

    E a terceira rotina que você apresentou como:

    Private Sub CheckBox9_Click()
      Dim lng As Long
      Dim strServ As String
      Dim strRef As String
      Dim TotServ As Integer
      Dim TotRef As Integer
      
      Me.ListBox5.Clear
      For lng = 1 To mclcServ.Count
        strServ = VBA.UCase(mclcServ(lng))
        strRef = VBA.UCase(mclcRef(lng))
          
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Felipe.

    Boa noite. Mais uma vez, obrigado pela rápida resposta. Não lhe sei dizer se são variáveis de módulo, pois não sei o que isso é, mas foi usada uma rotina que me cedeu num tópico anterior para exibir em Listbox, os nomes constantes na coluna "C".

    No entanto o problema persiste, na mesma linha,

    strRef = VBA.UCase(mclcRef(lng))

      "Runtime error 9" " Subscrpt Out of Range"

    Terá relação com o facto de serem coleções de items com base em colunas diferentes?

    "mclcRef" refere-se à coluna "K".

    "mclcServ" refere-se à coluna "L"

    Quanto à chamada da sub no evento Initialize, está feito como sugere. Apenas tem uma diferença. Neste momento juntei as duas Sub que enviei em uma só.

    Nas rotinas que anexei, se colocar o cliclo For--next a iniciar em 1, grava na Listbox o cabeçalho, daí ter colocado a começar em 2.

    Quanto à contagem, também não a faz, pelo menos de forma correta. Apresenta o nº 6 em todas as colunas e isso não corresponde à verdade.

    Se colocar a variável "strServ", incrementada de 1 a cada ciclo FOR/NEXT, dá erro de tipos de variáveis, já que as variáveis "strServ" e "strRef", são do tipo string.

    Na rotina que envia, não consigo testar a contagem, já que me dá erro antes de finalizar o procedimento, mas na linha amarela do debuger, o valor da variável que aparece ao colocar o rato em cima, está correto mas o valor de "lng" não está.

    Terei que utilizar uma checkbox para cada coluna?

    Um abraço.

    M_A_L

    terça-feira, 7 de janeiro de 2014 23:58
  • Sobre variáveis de nível de procedimento, de módulo e globais: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/#variaveis_locais_e_variaveis_globais

    ---

    Estou estranhando algo na sua rotina. Você está fazendo um laço em que a variável de controle percorre os itens da coleção mclcServ, mas está acessando itens da coleção mclcRef. Isso pode dar erro porque se a coleção mclcServ for maior que mclcRef, você obterá um erro de execução ao tentar acessar um item cujo índice da coleção mclcRef extrapole sua quantidade de itens.

    Logo, você precisará de duas caixas de listagem para ver os seus dois resumos de contagem: uma para a coleção mclcServ e outra para a coleção mclcRef.

    Você poderia fazer algo como mostrado a seguir, mas deve criar uma caixa de listagem extra para a coleção mclcRef chamada ListBox6:

    Private Sub CheckBox9_Click()
      Dim lng As Long
      Dim strServ As String
      Dim strRef As String
      Dim TotServ As Integer
      Dim TotRef As Integer
      
      With Me.ListBox5
        .ColumnCount = 2
        .ColumnWidths = "150;60"
        .Clear
        
        For lng = 1 To mclcServ.Count
          strServ = UCase(mclcServ(lng))
          .AddItem
          .List(.ListCount - 1, 0) = strServ
          .List(.ListCount - 1, 1) = TotServ
        Next lng
      End With
    
      With Me.ListBox6
        .ColumnCount = 2
        .ColumnWidths = "150;60"
        .Clear
        
        For lng = 1 To mclcRef.Count
          strRef = UCase(mclcRef(lng))
          .AddItem
          .List(.ListCount - 1, 0) = strRef
          .List(.ListCount - 1, 1) = TotRef
        Next lng
      End With
    End Sub
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:23
    quarta-feira, 8 de janeiro de 2014 01:18
    Moderador
  • Felipe, calculava que fossem necessários 2 objetos, por isso perguntei se a solução passaria por duas checkbox.

    Mas, na parte da programação, isso é que já é mais complicado.

    Você, trata o computador por "tu" e conhece-lhe bem o âmago, por isso, para si nada é complicado e em meia dúzia de minutos ... está feito.

    É realmente um programador fantástico, que num só olhar, detecta a falha, apesar de ter com certeza vários projetos em mãos, e então a confusão de variáveis deve ser tal, que punham a cabeça de qualquer um a deitar fumo.

    Mas você, é sempre tiro no centro do alvo.

    Preciso só de mais uma coisa.

    Por certo a variável de incremento não está correta, apesar de ter tentado de varias formas. Dá-me sempre "0" o somatório de cada item.

    Como deverei incrementar os valores para obter os somatórios corretos e em função desses valores poder obter as percentagens devidas?

    Muito, muito, muito obrigado pela ajuda que me tem prestado.

    Um abraço

    M_A_L

    quarta-feira, 8 de janeiro de 2014 02:10
  • As variáveis TotServ e TotRef devem ser declaradas em níveis de módulo, isto é, coloque-as fora de todos os procedimentos, na primeira linha de seu código, junto com mclcServ e mclcRef:

      Dim TotServ As Integer
      Dim TotRef As Integer


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 8 de janeiro de 2014 19:57
    Moderador
  • Boa noite Felipe.

    De uma forma ou de outra, o valor das strRef e strServ, dão resultado "0".

    Julgo que o problema será outro e penso que na forma de incrementar as variáveis.

    Se por exemplo "strRef = .Cells(lng, "K").Value", TotRef deverá ser incrementada com estes valores e para que TotRef guarde esses valores não deverá ser feito um "Set"?

    Ou então, fazer referência a "strRef = UCase(mclcRef(lng))" incrementando com o valor das Case.

    Só que, a ser assim como posso fazê-lo. Sem a sintaxe certa, ... nada feito.

    Grato.

    M_A_L

    quarta-feira, 8 de janeiro de 2014 23:47
  • Manuel,

    Avaliando melhor o problema, creio que o objeto Collection não será adequado para te dar os totais de cada item. Nesse caso, é melhor utilizar o objeto Dictionary. Veja o exemplo a seguir:

    Private Sub UserForm_Initialize()
      Dim wks As Excel.Worksheet
      
      Set wks = ThisWorkbook.Worksheets("Plan1")
      fncPopulateListBox Me.ListBox5, wks.Columns("K")
      fncPopulateListBox Me.ListBox6, wks.Columns("L")
    End Sub
    
    Private Sub fncPopulateListBox(lbo As MSForms.ListBox, rngCol As Excel.Range)
      Dim lngCol As Long
      Dim dic As Object ' Scripting.Dictionary
      Dim lng As Long
      Dim lngRow As Long
      Dim lngLast As Long
      Dim str As String
      Dim var As Variant
      Dim wks As Excel.Worksheet
      
      Set dic = CreateObject("Scripting.Dictionary")
      lngCol = rngCol.Column
      Set wks = rngCol.Parent
      With wks
        lngLast = .Cells(.Rows.Count, lngCol).End(xlUp).Row
        For lngRow = 2 To lngLast
          str = .Cells(lngRow, lngCol).Value
          If Len(str) > 0 Then
            If dic.Exists(str) Then
              dic(str) = dic(str) + 1
            Else
              dic.Add str, 1
            End If
          End If
        Next lngRow
      End With
    
      With lbo
        .ColumnCount = 2
        For Each var In dic.Keys
          .AddItem
          .List(.ListCount - 1, 0) = var
          .List(.ListCount - 1, 1) = dic(var)
        Next var
      End With
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L quinta-feira, 9 de janeiro de 2014 12:12
    quinta-feira, 9 de janeiro de 2014 01:03
    Moderador
  • Felipe, bom dia.

    Estava tentando adaptar este tipo de código que me facultou num tópico anterior, mas estava com problemas na sintaxe.

    Com a sua resposta, problema sanado por completo.

    Apenas não coloquei no evento inicialize as instruções para popular as listbox, mas sim no evento "checkbox_click", para poder preencher com o click ou limpar desmarcando a caixa.

    Devo-lhe pois mais um enorme agradecimento.

    Mas ... deixe-me fazer-lhe uma pergunta:

    Presumo que será possível, conciliar variáveis com objetos, do tipo Label(x), Label(y). Penso, se o meu raciocínio estiver correto, que estas instruções demonstram isso.

    Private Sub fncPopulateListBox(lbo As MSForms.ListBox, rngCol As Excel.Range)

    e

    With lbo

    É correto o meu raciocínio?

    Muito obrigado, Felipe.

    Vou marcar este tópico como resolvido, pois a dúvida seguinte, baseia-se num assunto completamente diferente deste.

    Cumprimentos e que Deus lhe pague toda a ajuda que me tem prestado.

    Muito Obrigado.


    • Editado M_A_S_L quinta-feira, 9 de janeiro de 2014 12:10
    quinta-feira, 9 de janeiro de 2014 12:07
  • Sim, criei essa função para não precisar escrever uma rotina para o ListBox5 e ListBox6.

    Sobre sua indagação a respeito do rótulo (Label), faça o teste a seguir: crie um formulário com 10 rótulos, chamando-os de Label1 a Label10. Insira o código a seguir na classe do formulário e execute o programa:

    Private Sub UserForm_Initialize()
      Dim lng As Long
      
      For lng = 1 To 10
        Me.Controls("Label" & lng).Caption = "Este é o rótulo " & lng
      Next lng
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sexta-feira, 17 de janeiro de 2014 17:48
    quinta-feira, 9 de janeiro de 2014 22:37
    Moderador
  • Boa tarde, Felipe.

    Muito obrigado pela resposta. Tenho tentado o For Next, mas a sintaxe ... obviamente não era a correta.

    Agora vai ser mais fácil, pois vou precisar de transferir o caption das Label para uma outra folha.

    Felipe.

    Na rotina para popular as listbox que me enviou, será possível inserir condições? Isto é. Se pretender que apenas sejam consideradas as células da coluna "K", cuja linha contenham o valor "CA" na coluna "G".

    Nas tentativas que fiz, ou me apresenta erros de incompatibilidade das variáveis, ou não imprime nada, ou me apresenta todos os valores.

    Acha que será possível?

    Abraços.

    M_A_L 


    • Editado M_A_S_L sexta-feira, 10 de janeiro de 2014 14:20
    sexta-feira, 10 de janeiro de 2014 14:19
  • Felipe.

    Já consegui.

    Muito obrigado

    M_A_L

    sábado, 11 de janeiro de 2014 12:19