Inserire dati tramite textbox in successione su determinate colonne di un foglio di Excel.

Question

Buongiorno a tutti, sto provando ad adattare un codice che ho trovato in rete per poter incollare dei dati inseriti in 10 Textbox su due colonne di un foglio di Excel che utilizzo come base dati.

I dati inseriti nelle textbox devono incollarsi in successione in due colonne e precisamente nelle colonna B e nella colonna E (quest'ultima deve avere il formato Valuta, con due decimali senza simbolo euro)

Allego il codice che non riesco a far funzionare in base alle mie esigenze.

Private Sub CommandButton18_Click()

Application.ScreenUpdating = False

 Sheets("ANTICIPI").Select  'si seleziona un'altro foglio

 Dim iRow As Integer

 iRow = 2

 While Cells(iRow, 1).Value <> ""

 iRow = iRow + 1

 Wend

 Cells(iRow, 1) = TextBox1 'Cells(iRow, 1).Offset(-1, 0) + 1 'QUESTO INCREMENTA DI 1 IL NR. PROGRESSIVO IN COLONNA A

 Cells(iRow, 2) = TextBox2

 Cells(iRow, 1) = TextBox3

 Cells(iRow, 2) = TextBox4

 Cells(iRow, 1) = TextBox5

 Cells(iRow, 2) = TextBox6

 Cells(iRow, 1) = TextBox7

For i = 1 To 10

  Controls("TextBox" & i) = ""

Next i

  End Sub

Ringrazio anticipatamente che mi aiuta in questo.

Ciao Nicola.

Answer 1

Ciao Nicola,

Buongiorno a tutti, sto provando ad adattare un codice che ho trovato in rete per poter incollare dei dati inseriti in 10 Textbox su due colonne di un foglio di Excel che utilizzo come base dati.

I dati inseriti nelle textbox devono incollarsi in successione in due colonne e precisamente nelle colonna B e nella colonna E (quest'ultima deve avere il formato Valuta, con due decimali senza simbolo euro)

Allego il codice che non riesco a far funzionare in base alle mie esigenze.

Private Sub CommandButton18_Click()

Application.ScreenUpdating = False

 Sheets("ANTICIPI").Select  'si seleziona un'altro foglio

 Dim iRow As Integer

 iRow = 2

 While Cells(iRow, 1).Value <> ""

 iRow = iRow + 1

 Wend

 Cells(iRow, 1) = TextBox1 'Cells(iRow, 1).Offset(-1, 0) + 1 'QUESTO INCREMENTA DI 1 IL NR. PROGRESSIVO IN COLONNA A

 Cells(iRow, 2) = TextBox2

 Cells(iRow, 1) = TextBox3

 Cells(iRow, 2) = TextBox4

 Cells(iRow, 1) = TextBox5

 Cells(iRow, 2) = TextBox6

 Cells(iRow, 1) = TextBox7

For i = 1 To 10

  Controls("TextBox" & i) = ""

Next i

  End Sub

In un modulo standard, incolla la seguente funzione:@

'=========>>

Option Explicit

'--------->>

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range, _

                 Optional minRow As Long = 1)

    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

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Nel modulo di codice della Userform, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub CommandButton18_Click()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, Rng2 As Range

    Dim arr() As Variant, arr2() As Variant

    Dim i As Long, j As Long, LRow As Long

    Const sFoglio As String = "ANTICIPI"

    Const sPrimaColonna As String = "B:B"

    Const sSecondaColonna As String = "E:E"

    Const iNumeroDiTextBox As Long = 10

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns(sPrimaColonna))

        Set Rng = .Cells(LRow + 1, sPrimaColonna).Resize(iNumeroDiTextBox)

        Set Rng2 = .Cells(LRow + 1, sSecondaColonna).Resize(iNumeroDiTextBox)

    End With

    ReDim arr(1 To iNumeroDiTextBox)

    ReDim arr2(1 To iNumeroDiTextBox)

    For i = 1 To iNumeroDiTextBox

        If i Mod 2 = 1 Then

            j = j + 1

            arr(j) = Me.Controls("TextBox" & i).Value

        Else

            arr2(j) = Me.Controls("TextBox" & i).Value

        End If

    Next i

    With Application

         On Error GoTo XIT

        .ScreenUpdating = False

        Rng.Value = .Transpose(arr)

        Rng2.Value = .Transpose(arr2)

XIT:

        .ScreenUpdating = True

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Nicola,

Va benissimo il tuo codice, lo contrassegno come risposta preferita per altri che come me hanno la stessa esigenza.

Ti ringrazio per il cortese riscontro ma vedi la mia ultima risposta con il codice riveduto.

===

Regards,

Norman

Answer 3

Ciao Nicola,

Per correggere  un errore nel mio codice e per indirizzare la tua richiesta per la formatazzione dei dati incollati nella colonna E, sostituisci il codice per il controllo CommandButton18 con la seguente versione:

'=========>>

Option Explicit

'--------->>

Private Sub CommandButton18_Click()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, Rng2 As Range

    Dim arr() As Variant, arr2() As Variant

    Dim i As Long, j As Long, LRow As Long

    Const sFoglio As String = "ANTICIPI"

    Const sPrimaColonna As String = "B:B"

    Const sSecondaColonna As String = "E:E"

    Const iNumeroDiTextBox As Long = 10

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns(sPrimaColonna))

        Set Rng = .Cells(LRow + 1, sPrimaColonna).Resize(iNumeroDiTextBox / 2)

        Set Rng2 = .Cells(LRow + 1, sSecondaColonna).Resize(iNumeroDiTextBox / 2)

    End With

    ReDim arr(1 To iNumeroDiTextBox / 2)

    ReDim arr2(1 To iNumeroDiTextBox / 2)

    For i = 1 To iNumeroDiTextBox

        If i Mod 2 = 1 Then

            j = j + 1

            arr(j) = Me.Controls("TextBox" & i).Value

        Else

            arr2(j) = Me.Controls("TextBox" & i).Value

        End If

    Next i

    With Application

        On Error GoTo XIT

        .ScreenUpdating = False

        Rng.Value = .Transpose(arr)

        Rng2.Value = .Transpose(arr2)

        Rng2.NumberFormat = "0.00"

XIT:

        .ScreenUpdating = True

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 4

Ciao Norman, innanzitutto grazie infinite per il tuo gentile riscontro.

Va benissimo il tuo codice, lo contrassegno come risposta preferita per altri che come me hanno la stessa esigenza.

Ciao Nicola.