Crie um form com três ComboBox -
ComboBox1, ComboBox2 e ComboBox3 e use o código abaixo:
Option Explicit
Const strAdicionarItem_C As String = "(novo item...)"
Dim ws As Worksheet
Private Sub ComboBox3_Change()
GeneralChangeCombo 3, ComboBox3, Nothing, ComboBox2
End Sub
Private Sub UserForm_Initialize()
Set ws = ActiveSheet
Inicializar
End Sub
Private Sub ComboBox1_Change()
GeneralChangeCombo 1, ComboBox1, ComboBox2
End Sub
Private Sub ComboBox2_Change()
GeneralChangeCombo 2, ComboBox2, ComboBox3, ComboBox1
End Sub
Private Sub UserForm_Terminate()
Set ws = Nothing
End Sub
Private Sub GeneralChangeCombo(cCol As Long, ctrlIn As Control, ctrlOut As Control, Optional ctrlPai As Control)
Dim rInício As Long
Dim rFim As Long
With ws
If ctrlIn = strAdicionarItem_C Then
Dim strNovoItem
strNovoItem = InputBox("Qual é o novo item que deseja adicionar?", "Adicionar novo item")
If strNovoItem = vbNullString Then
Exit Sub
Else
If cCol = 1 Then
.Rows(1).Insert
.Range("A1") = strNovoItem
rFim = .Cells(.Rows.Count, 1).End(xlUp).Row
Else
rInício = .Columns(cCol - 1).Find(ctrlPai, , , xlWhole).Row
.Rows(rInício + 1).Insert
.Cells(rInício + 1, cCol) = strNovoItem
End If
LimparTodos
End If
Else
If Not ctrlOut Is Nothing Then
rInício = .Columns(cCol).Find(ctrlIn, , , xlWhole).Row
If .Cells(rInício, cCol).Offset(1) = vbNullString Then
rFim = .Cells(rInício, cCol).End(xlDown).Row
If rFim = .Rows.Count Then
rFim = .Cells(.Rows.Count, cCol + 1).End(xlUp).Row
If rFim < rInício Then
rFim = rInício
End If
End If
Else
rFim = rInício + 1
End If
AdicionarItens cCol + 1, ctrlOut, rInício, rFim
End If
End If
End With
End Sub
Private Sub AdicionarItens(lngColuna As Long, ctrl As Control, lngStart As Long, lngEnd As Long, Optional blÚltimoNível = False)
Dim n As Long
ctrl.Clear
With ws
For n = lngStart To lngEnd
If .Cells(n, lngColuna) <> vbNullString Then
ctrl.AddItem .Cells(n, lngColuna)
End If
Next n
If Not blÚltimoNível Then
ctrl.AddItem strAdicionarItem_C
End If
End With
End Sub
Private Sub Inicializar()
Dim rLast As Long
With ws
rLast = .Cells(.Rows.Count, 1).End(xlUp).Row
AdicionarItens 1, Controls("ComboBox1"), 1, rLast
End With
End Sub
Private Sub LimparTodos()
Dim ctrl As Control
For Each ctrl In Controls
If TypeName(ctrl) = "ComboBox" Then
ctrl.Clear
End If
Next ctrl
Inicializar
End Sub
http://www.ambienteoffice.com.br
