Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao Nicola,
Ciao Normann, se ti è possibile, ti chiedo la cortesia di poter visualizzare nella listbox le intestazioni di colonna in corrispondenza dei dati trovati es:
Nr. Progressivo Matricola Cognome e Nome
E' possibile inoltre selezionare il dato nella listbox e aprire il contestuale foglio di lavoro su cui è posizionato il dato che seleziono.
Questo mi faciliterebbe moltissimo il lavoro e cioè non aprire manualmente il foglio di lavoro dopo aver annotato prima (o a memoria oppure su una carta) il dato trovato memorizzando anche il foglio.
Chiedo scusa per il ritardo con cui ti rispondo ma sono stato molto impegnato altrove.
Prova quanto segue: -
Crea una Userform con una Label (Label1), una TextBox (TextBox1), una ListBox (ListBox1) e due CommandButton (CommandButton1e CommandButton2 ). Non preoccuparti per le dimensioni, la posizione o le altre proprietà di questi oggetti!
· Alt-F11 per aprire l'editor di VBA
· Alt-IM per inserire un nuovo modulo di codice
Nel nuovo modulo vuoto, incolla il seguente codice:
'===========>>
Option Explicit
'--------->>
Public Sub ApriUserform()
UserForm1.Show False
End Sub
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'--------->>
Public Sub RenameSheetsAsMonths()
Dim WB As Workbook
Dim ArrMese As Variant
Dim i As Long
Set WB = ActiveWorkbook
ArrMese = Application.GetCustomListContents(4)
On Error Resume Next
For i = 1 To 12
WB.Sheets(i).Name = ArrMese(i)
Next i
On Error GoTo 0
End Sub
'<<=========
Nel modulo della Userform, incolla il seguente codice:
'=========>>
Option Explicit
Dim WB As Workbook
Dim tempSH As Worksheet
Const sName As String = "TempData"
Private Sub ListBox1_Click()
Dim i As Long
Dim SH As Worksheet
Dim destRng As Range
On Error Resume Next
With Me.ListBox1
Set SH = WB.Sheets(.List(.ListIndex, 3))
Set destRng = SH.Range("A" & .List(.ListIndex, 4)).Resize(1, 3)
Application.Goto destRng
End With
On Error GoTo 0
End Sub
'--------->>
Private Sub UserForm_Initialize()
With Me
.Caption = "Estra & Trova Record"
.BackColor = &HC0E0FF
.Height = 190
.Width = 288.75
With .ListBox1
.ColumnCount = 5
.ColumnWidths = "37;48;90;45;22"
.ColumnHeads = True
.BackColor = &HC0FFFF
.Left = 18
.Top = 54
.Height = 72
.Width = 247.5
End With
With .CommandButton1
.ForeColor = &H8000&
.Font.Bold = True
.Caption = "Estrarre Record"
.Width = 80
.Left = 115.5
.Top = 142.5
End With
With .CommandButton2
.Caption = "Esci"
.Width = 40
.ForeColor = vbRed
.Font.Bold = True
.Left = 229.5
.Top = 142.5
End With
With Me.TextBox1
.ForeColor = vbRed
.BackColor = &HC0FFFF
.Font.Bold = True
.Left = 18
.Top = 27
End With
With .Label1
.Width = 144
.Caption = "Matricola o Nome & Cognome"
.BackColor = &HC0E0FF
.ForeColor = vbBlue
.Font.Bold = True
.Left = 6
.Top = 12
End With
End With
On Error Resume Next
Set WB = ThisWorkbook
With WB
Set tempSH = .Sheets("TempData")
If Not tempSH Is Nothing Then
tempSH.Cells.ClearContents
Else
Set tempSH = .Sheets.Add
With tempSH
.Name = sName
.Visible = xlSheetVeryHidden
End With
End If
End With
On Error GoTo 0
End Sub
'--------->>
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Call CommandButton2_Click
End If
End Sub
'--------->>
Private Sub CommandButton1_Click()
Dim arrFogli As Variant
Dim arrIn As Variant, arrOut() As Variant
Dim SH As Worksheet
Dim Rng As Range, destRng As Range
Dim arrIntestazioni As Variant
Dim i As Long, j As Long, k As Long
Dim LRow As Long, iCol As Long
Dim sStr As String, aStr As String
Dim Res As Variant
Dim blMatricola As Boolean, blNome As Boolean
Const sIntestazioni As String = "Nr.Progressivo,Matricola," _
& "Cognome e Nome,Foglio,Riga"
ActiveCell.Select
arrIntestazioni = Split(sIntestazioni, ",")
sStr = UCase(Me.TextBox1.Value)
If sStr Like "??????[A-Z]" Then
blMatricola = True
iCol = 2
aStr = "La Matricola "
ElseIf sStr = vbNullString Then
Exit Sub
Else
blNome = True
iCol = 3
aStr = "Il Nome & Cognome "
End If
arrFogli = Application.GetCustomListContents(4)
ReDim Preserve arrOut(1 To 5, 1 To 1)
For k = LBound(arrIntestazioni) To UBound(arrIntestazioni)
arrOut(k + 1, 1) = arrIntestazioni(k)
Next k
j = 1
For Each SH In WB.Worksheets
With SH
Res = Application.Match(SH.Name, arrFogli, 0)
If Not IsError(Res) Then
LRow = .Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = .Range("A2:C" & LRow)
arrIn = Rng.Value
For i = 1 To LRow - 1
If UCase(arrIn(i, iCol)) = sStr Then
j = j + 1
ReDim Preserve arrOut(1 To 5, 1 To j)
For k = 1 To 3
arrOut(k, j) = arrIn(i, k)
Next k
arrOut(4, j) = .Name
arrOut(5, j) = i + 1
End If
Next i
End If
End With
Next SH
If j > 1 Then
With tempSH
.Cells.ClearContents
Set destRng = .Range("A1").Resize(j, 5)
destRng.Value = Application.Transpose(arrOut)
Me.ListBox1.RowSource = _
.Range("A2").Resize(j - 1, 5).Address(External:=True)
End With
Else
Call MsgBox(Prompt:=aStr & sStr & " non e' stato trovato!", _
Buttons:=vbInformation, _
Title:="NON TOVATO!")
End If
End Sub
'--------->>
Private Sub TextBox1_AfterUpdate()
Me.CommandButton1.SetFocus
End Sub
'--------->>
Private Sub CommandButton2_Click()
tempSH.Cells.ClearContents
Unload Me
End Sub
'<<=========
Potresti scaricare il mio file di prova (NicolaV2_20150206) a: http://1drv.ms/1ADNA5q
Quando apri il mio file, vedrai che ho aggiunto un pulsante del tipo Forms (non ActiveX) e ho assegnato il pulsante alla macro ApriUserform. Se utilizzi questo pulsante per aprire la Userform, sarai in grado di navigare in tutta la cartella di lavoro anche quando la Userform è aperta.
===
Regards,
Norman