francescofrancesco
XLDnaute Junior
Bonjour, pouvez-vous optimiser ce code pour le rendre plus rapide ?
Excel 2003
Excel 2003
VB:
'----------------------array textbox-------------------------------------------
Dim arrA()
If UserForm33.TextBox1 <> "" Then x1 = CLng(CDate(TextBox1))
If UserForm33.TextBox1 <> "" Then x2 = CDate(UserForm33.TextBox1) 'data fattura
x3 = UserForm33.TextBox2
On Error Resume Next
'se vuoi inserire tre righe variare il parametro a 3
'UserForm33.TextBox3.Text = Right(UserForm33.TextBox3.Text, Len(UserForm33.TextBox3.Text) - InStr(UserForm33.TextBox3.Text, vbCrLf))
n = Split(UserForm33.TextBox3, vbCr, 2)
primariga = UCase(n(0))
If n(1) <> "" Then
secondariga = n(1)
secondariga = Replace(secondariga, Chr(13), "")
Else
secondariga = ""
End If
If UserForm33.TextBox30 <> "" Then
x4 = UCase(Replace(UserForm33.TextBox30.Text, vbCr, "")) & vbNewLine & LCase(primariga) & LCase(Trim(secondariga))
Else
x4 = UCase(primariga) & LCase(Trim(secondariga))
End If
x5 = CDbl(UserForm33.TextBox4)
x6 = CDbl(UserForm33.TextBox5)
x7 = CDbl(UserForm33.TextBox6)
x8 = CDbl(UserForm33.TextBox7)
If UserForm33.TextBox1 <> "" Then x9 = CLng(CDate(UserForm33.TextBox1))
'arrA = Array(x1, x1, x3, x4, x5, x6, " ", x7, x8, x9, x1)
If UserForm33.TextBox1 <> "" Then
'----------verifica se la data esiste in colonna J----------------
On Error GoTo NotFound
'idx = Application.match(Val(dt1), Range("J2:J" & LR), 1)
idx = Application.match(dt1, f.Range("J2:J" & f.Range("A" & f.Rows.count).End(xlUp).row), 1)
'Rg = Application.match(Sch, ws1.Columns(10), True)
If idx > 0 Then
MsgBox (idx)
'Else
'NotFound:
' MsgBox ("No Match Was Found")
'End If
Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------
'tableau des données de la feuille "primanota"
With f: Tablo2 = .Range(.Cells(2, 1), .Cells(.Columns(1).Cells(.Rows.count).End(xlUp).row, 10)).Value2: End With
nbl = UBound(Tablo2, 1)
'tableau provisoire pour Redim (col,lignes)
ReDim TabloTemp(1 To 10, 1 To nbl)
For i = 1 To nbl: For j = 1 To 10
TabloTemp(j, i) = Tablo2(i, j)
Next j: Next i
If Mid(f.Cells(idx + 1, "D"), 1, 2) = "CD" Then idx = idx - 1
f.Cells(idx, "A").EntireRow.Insert
nbl = nbl + 1
ReDim Preserve TabloTemp(1 To 10, 1 To nbl)
For k = nbl To idx + 2 Step -1: For j = 1 To 10
TabloTemp(j, k) = TabloTemp(j, k - 1)
Next j: Next k
TabloTemp(1, idx + 1) = x1
TabloTemp(2, idx + 1) = x1
TabloTemp(3, idx + 1) = x3
TabloTemp(4, idx + 1) = x4
TabloTemp(5, idx + 1) = x5
TabloTemp(6, idx + 1) = x6
TabloTemp(8, idx + 1) = x7
TabloTemp(9, idx + 1) = x8
TabloTemp(10, idx + 1) = x1
' For i = 1 To nbl
' TabloTemp(1, i) = i
' Next
' f.Cells(2, 1).Resize(nbl, 10).Value = Application.Transpose(TabloTemp)
ar = WorksheetFunction.Transpose(TabloTemp)
f.Cells(2, 1).Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar
Else
NotFound:
MsgBox ("No Match Was Found")
End If
End If
Dernière édition:
