Este fórum está sendo desativado

[JCabral]

Boa tarde

Precisava de ajuda para o seguinte problema:
Tenho uma Userform com uma ComboBox e uma ListaBox e precisava que os itens fossem adicionados em função de um Rank, ou seja:

- A primeira vez que abro a userform o Rank é igual para todos, conforme vou selecionado os nomes, vou adicionando (+1) ao valor existente do Rank e assim a próxima vez que abrir a userform os primeiros dados a aparecer na ComboBox e na ListBox são os que têm maior valor na coluna Rank;

O que se pretende é que os primeiros dados que aparecem na ComboBox/ListBox são os que mais são usados.
Anexo ficheiro com a Userform e com alguns dados, sendo que o Rank está a zeros para todos. O que se pretende é que na Combobox só venham os NOME COMPLETOS e Na ListBox venham os NOME COMPLETOS e a SECÇÃO.

Obrigado

[osvaldomp]

Salve, Jorge.

Considerei apenas a ListBox, veja se é o suficiente.

Selecione um ou mais itens e clique no botão Escolher.

Código: Selecionar todos

Private Sub UserForm_Initialize()
 Dim LR As Long
  LR = Sheets("Folha1").Cells(Rows.Count, 1).End(3).Row
  Sheets("Folha1").Range("A1:C" & LR).Sort Key1:=[C1], Order1:=xlDescending, Header:=xlYes
  With Me.ListBox1
   .ColumnCount = 3
   .ColumnHeads = True
   .ColumnWidths = "110;40;10"
   .MultiSelect = fmMultiSelectMulti
   .RowSource = "Folha1!A2:C" & LR
  End With
End Sub

Código: Selecionar todos

Private Sub CommandButton1_Click()
 Dim k As Long, n As Long, LR As Long
  If ListBox1.ListIndex = -1 Then Exit Sub
  For k = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(k) = True Then
    With Sheets("Folha1")
     LR = .Cells(Rows.Count, 1).End(3).Row
     n = .Range("A2:A" & LR).Find(ListBox1.List(k)).Row
     .Cells(n, 3) = .Cells(n, 3) + 1
     .Range("A1:C" & LR).Sort Key1:=[C1], Order1:=xlDescending, Header:=xlYes
    End With
   End If
  Next k
End Sub

[Strogonoff]

Caro amigo , boa noite
Sempre temos mais de um caminho para chegar a um resultado, e talvez até mais rápidos que este apresentado...
Segue uma singela sugestão para o que você propôs.
Espero que ajude, e aproveite as duas resposta para criar sua própria linhas de prgramação...
Abraço

[osvaldomp]

Salve, Jorge.

Segue uma alternativa sem o uso de Form.

Instale uma cópia do código abaixo no módulo da Folha1 .
Para adicionar 1 ao Rank aplique duplo clique ou sobre o nome ou sobre a secção ou sobre o rank.

Código: Selecionar todos

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Target.Column > 3 Or Cells(Target.Row, 1) = "" Then Exit Sub
 Cells(Target.Row, 3) = Cells(Target.Row, 3) + 1
 Range("A1:C" & Cells(Rows.Count, 1).End(3).Row).Sort Key1:=[C1], Order1:=xlDescending, Header:=xlYes
 Cancel = True
End Sub

[JCabral]

Obrigado Osvaldo / Strogonoff

Osvaldo estou a ter um "erro" quando seleciono mais do que um item na Listbox , ou seja só no primeiro item é feito o incremento. O que me parece é que depois de escrever na planilha o incremento todos os itens da Listbox são desseleccionados e por isso no loop seguinte a seleção vem "False" para todos os itens, tem como contornar este problema?

Strogonoff testei a sua solução no Excel 2013 e deu erro em:

Código: Selecionar todos

    ActiveWorkbook.Worksheets("Folha1").Sort.SortFields.Add2 Key:=w.Range("C2:C" & lUltLin) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

tem como contornar este problema?

Muito obrigado aos dois mais uma vez.

[osvaldomp]

Salve, Jorge.

Verdade. Falha minha.

Experimente o código abaixo no lugar do anterior, sff.

Código: Selecionar todos

Private Sub CommandButton1_Click()
 Dim k As Long, n As Long, LR As Long
  If ListBox1.ListIndex = 0 Then Exit Sub
  For k = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(k) = True Then
    With Sheets("Folha1")
     LR = .Cells(Rows.Count, 1).End(3).Row
     n = .Range("A2:A" & LR).Find(ListBox1.List(k)).Row
     Application.Calculation = xlCalculationManual
     .Cells(n, 3) = .Cells(n, 3) + 1
    End With
   End If
  Next k
  Application.Calculation = xlCalculationAutomatic
  Sheets("Folha1").Range("A1:C" & LR).Sort Key1:=[C1], Order1:=xlDescending, Header:=xlYes
End Sub

[Strogonoff]

por favor tenta agora
dei uma melhorada no código

[JCabral]

Salve, Jorge.

Verdade. Falha minha.

Experimente o código abaixo no lugar do anterior, sff.

Código: Selecionar todos

Private Sub CommandButton1_Click()
 Dim k As Long, n As Long, LR As Long
  If ListBox1.ListIndex = 0 Then Exit Sub
  For k = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(k) = True Then
    With Sheets("Folha1")
     LR = .Cells(Rows.Count, 1).End(3).Row
     n = .Range("A2:A" & LR).Find(ListBox1.List(k)).Row
     Application.Calculation = xlCalculationManual
     .Cells(n, 3) = .Cells(n, 3) + 1
    End With
   End If
  Next k
  Application.Calculation = xlCalculationAutomatic
  Sheets("Folha1").Range("A1:C" & LR).Sort Key1:=[C1], Order1:=xlDescending, Header:=xlYes
End Sub

Tudo OK, muito obrigado

[JCabral]

por favor tenta agora
dei uma melhorada no código

Caro Strogonoff

Continua a dar erro, incluindo quando abro o ficheiro dá-me erro "Encontrámos um problema de conteúdos em "PopulateComboBoxRank_resposta.xlsm". Pretende recuperar o máximo possível? Se a origem deste ficheiro for fidedigna, clique em Sim.

[Strogonoff]

Caro JCabral
boa noite!!
está dando essa mensagem, pois tem macros, essa mensagem que você falou realmente aparece.
você pode dar sim e não habilitar a macro, e se quiser copiar o codigo ou rodar o programa, fica a seu critério.

[JCabral]

Ok, mas continua a dar erro em:

Código: Selecionar todos

    w.Sort.SortFields.Add2 Key:=w.Range("C2:C" & lUltLin) _
        , SortOn:=xlSortOnValues, Order:=xlDescending

ERRO: Run-time error '438': Object doesn't support this property or method

Obrigado

[Strogonoff]

Amigo
vou passar o codigo aqui
talvez fique mais pratico para você

copiar o codigo no proprio userform

Option Explicit
Dim rg As Range
Dim lUltLin As Long
Dim w As Worksheet

Private Sub UserForm_Initialize()
Set w = Folha1
''''''''''''''''''''''''''''''''''''''''''
'CONFIGURAÇÃO INICIAL
'''''''''''''''''''''''''''''''''''''''''''
Call ClassificarLista
''''''''''''''''''''''''''''''''''''''''''
'CARREGANDO O CBO E LIST
'''''''''''''''''''''''''''''''''''''''''''
Call CarregaCboeList
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim sNome As String
Dim lrank As Long
Dim lLine As Long: lLine = 1

''''''''''''''''''''''''''''''''''''''''''
'TRATAMENTO DE ERRO
'''''''''''''''''''''''''''''''''''''''''''
If Me.ComboBox1.Value = "" Then
Exit Sub
End If
sNome = Me.ComboBox1.Value
lLine = w.Range("a:A").Find(sNome).Row
''''''''''''''''''''''''''''''''''''''''''
'INCREMENTANDO O RANK
'''''''''''''''''''''''''''''''''''''''''''
lrank = w.Cells(lLine, "C").Value
lrank = lrank + 1
w.Cells(lLine, "C").Value = lrank
MsgBox " Você selecionou " & sNome & Chr(13) & _
" e foi selecionado: " & lrank & " Vez(es)"
''''''''''''''''''''''''''''''''''''''''''
'ATUALIZANDO O CBO E LIST
'''''''''''''''''''''''''''''''''''''''''''

Call ClassificarLista
End Sub

Private Sub CommandButton1_Click()
Dim sNome As String
Dim lrank As Long
Dim lLine As Long: lLine = 1

''''''''''''''''''''''''''''''''''''''''''
'TRATAMENTO DE ERRO
'''''''''''''''''''''''''''''''''''''''''''
If Me.ListBox1.Value = "" Then
Exit Sub
End If
sNome = Me.ListBox1.List(, 0)
lLine = w.Range("a:A").Find(sNome).Row
''''''''''''''''''''''''''''''''''''''''''
'INCREMENTANDO O RANK
'''''''''''''''''''''''''''''''''''''''''''
lrank = w.Cells(lLine, "C").Value
lrank = lrank + 1
w.Cells(lLine, "C").Value = lrank
MsgBox " Você selecionou " & sNome & Chr(13) & _
" e foi selecionado: " & lrank & " Vez(es)"
''''''''''''''''''''''''''''''''''''''''''
'ATUALIZANDO O CBO E LIST
'''''''''''''''''''''''''''''''''''''''''''

Call ClassificarLista

End Sub

Sub CarregaCboeList()
Dim i As Integer
Dim iDados As Integer: iDados = 0

Me.ComboBox1.Clear ' limpando a combobox
Me.ListBox1.Clear 'limpando a listbox
For i = 2 To lUltLin
With UserForm1.ListBox1
.AddItem
.List(iDados, 0) = w.Cells(i, "A")
.List(iDados, 1) = w.Cells(i, "B")
iDados = iDados + 1
End With
UserForm1.ComboBox1.AddItem w.Cells(i, "A").Value
Next i

End Sub

Sub ClassificarLista()
Set rg = w.Range("A1").CurrentRegion
lUltLin = rg.Rows.Count ' definindo a ultima linha

''''''''''''''''''''''''''''''''''''''''''
'CRIANDO O RANK DO MAIOR PARA O MENOR
'''''''''''''''''''''''''''''''''''''''''''
w.Range("C2:C" & lUltLin).Select
ActiveWorkbook.Worksheets("Folha1").Sort.SortFields.Add2 Key:=Range("C2:C" & lUltLin) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With w.Sort
.SetRange Range("A2:C" & lUltLin)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Call CarregaCboeList

End Sub