Function tbl(rng)
tbl = rng.Value
End Function
original | matricielle | ||||
toto | toto | ||||
titi | titi | formule validée en matricielle:=tbl(A1:A7) | |||
riri | riri | ||||
fifi | fifi | ||||
loulou | loulou | ||||
truc | truc | ||||
bidule | bidule | ||||
machin | #N/A | ||||
chouette | #N/A | ||||
blablabla | #N/A | ||||
toto | #N/A | ||||
taratata | #N/A | ||||
turlututu | #N/A | ||||
chapeau | #N/A | ||||
pointu | #N/A |
Function TBLX2(rng As Range)
Dim t1, t2, L&, C&: t1 = rng.Value: t2 = Application.Caller.Value
'MsgBox UBound(t2)'c'est bon le t2 est bien un tableau
For L = 1 To UBound(t2)
For C = 1 To UBound(t2, 2)
't2(L, C) = ""'on le vide pour éviter le 0 ou NA ou REF!
If L <= UBound(t1) And C <= UBound(t1, 2) Then t2(L, C) = t1(L, C)
Next
Next
TBLX2 = t2
End Function
Chocolat ? Quand tu affirmes une chose teste avant, ce fichier (2) ne pose pas de problème.@job75
mais si les formules devaient aller sur une autre feuille ben on est chocolatje devrais utiliser le usedrange de la feuille destination en espérant qu'il y est assez de lignes
Function Matrice(R As Range)
'R est une plage rectangulaire quelconque
Dim nlig&, ncol%, tablo, i&, j%
nlig = R.Rows.Count: ncol = R.Columns.Count
tablo = R.Resize(R.Parent.UsedRange.Rows.Count + 1, ncol) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
For j = 1 To ncol
If i > nlig Or j > ncol Then tablo(i, j) = ""
Next j, i
Matrice = tablo
End Function
Function tbl(rng As Range)
Dim t, i&, j&
ReDim r(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
t = rng.Value
For i = 1 To UBound(r): For j = 1 To UBound(r, 2): r(i, j) = "": Next j, i
For i = 1 To UBound(t): For j = 1 To UBound(t, 2): r(i, j) = t(i, j): Next j, i
tbl = r
End Function
Function TBLX(RnG As Range)
Dim X1&, X2, y1&, Y2, X&,C&,T
X1 = RnG.Rows.Count 'nombre de lignes du tableau by RnG
y1 = RnG.Columns.Count 'nombre de colonnes du tableau by RnG
X2 = Evaluate("ROW(1:" & Application.Caller.Rows.Count & ")") 'création array 2 dimensions(x lignes = nombre de colonne du caller)
y2 = Application.Transpose(Evaluate("ROW(1:" & Application.Caller.Columns.Count & ")")) 'création array 1 dimension(x items = nombre de colonne du caller)
'redimensionnement du tableau rng
'shemas:=Application.Index( [tableau original] , [array 2 dim pour les lignes] , [ array 1 dim pour les colonnes] )
T = Application.Index(RnG.Value, X2, y2)
For a = 1 To UBound(T) 'boucle sur les lignes du tableau
For C = 1 To UBound(T, 2) 'boucles sur les colonne du tableau
If a > X1 Or C > y1 Then T(a, C) = "" ' si on depasse les dimensions originales (lignes ou colonnes) on clear l'items du tableau
Next C
Next a
TBLX = T
End Function
Function tbl(rng As Range)
Dim t, i&, j&
ReDim r(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
t = rng.Value
For i = 1 To UBound(r): For j = 1 To UBound(r, 2): r(i, j) = "": Next j, i
For i = 1 To UBound(t): For j = 1 To UBound(t, 2): r(i, j) = IIf(t(i, j) = "", "", t(i, j)): Next j, i
tbl = r
End Function
Re,visiblement la plus simple est bien ma version de base
Ta version de base n'est pas la plus simple.visiblement la plus simple est bien ma version de base
a savoir redimensionner le tableau (argument)
non pas forcement @mapomme démontre que l'utilisation d'un autre tableau fonctionne aussiEt bien sûr redimensionner le tableau (argument) est indispensable, c'est la seule solution.
c'est la seule avec la quelle je n'ai pas de soucis sur 2007 2013 2016 (les 3 en 32 bits)Ta version de base n'est pas la plus simple.
Function tbl(rng As Range)
Dim t, x, i&, j&
ReDim r(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
t = rng.Value
If Not IsArray(t) Then x = t: ReDim t(1 To 1, 1 To 1): t(1, 1) = x
For i = 1 To UBound(r): For j = 1 To UBound(r, 2): r(i, j) = "": Next j, i
For i = 1 To UBound(t): For j = 1 To UBound(t, 2): r(i, j) = IIf(t(i, j) = "", "", t(i, j)): Next j, i
tbl = r
End Function
re
mapomme ca marche aussi
va savoir toi
Function tblmapomme(rng As Range)
'base @mapomme + dico patricktoulon
Dim t, i&, j&, dico As Object, r
ReDim r(1 To Application.Caller.Rows.Count, 1 To 2)
Set dico = CreateObject("Scripting.Dictionary")
t = rng.Value
For i = 1 To UBound(t): dico(t(i, 1)) = Val(dico(t(i, 1))) + 1: Next 'enregistrement dans dico key chaine;items nbres d'occurences
k = dico.keys: it = dico.items 'dico to array
For i = 1 To UBound(r) 'on clear les items du tableau
For j = 1 To UBound(r, 2): r(i, j) = ""
Next j
Next i
For i = 0 To UBound(k): r(i + 1, 1) = k(i): r(i + 1, 2) = it(i): Next
tblmapomme = r
End Function
oui selon comment tu aborde la chose en terme d'organigramme dans le code ben tu es chocolatEt pourtant c'est ce qu'on aimerait bien comprendre
Sub test()
X = tblmapomme([A1:A15].Value)
[F1].Resize(UBound(X), 2) = X
End Sub
Function tblmapomme(rng As Variant)
'base @mapomme + dico patricktoulon
Dim t, i&, j&, dico As Object, r
If TypeName(rng) = "Range" Then t = rng.Value Else t = rng
On Error Resume Next
ReDim r(1 To Application.Caller.Rows.Count, 1 To 2)
If Err.Number > 0 Then ReDim r(1 To UBound(rng), 1 To 2)
On Error GoTo 0
Set dico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t): dico(t(i, 1)) = Val(dico(t(i, 1))) + 1: Next 'enregistrement dans dico key chaine;items nbres d'occurences
k = dico.keys: it = dico.items 'dico to array
For i = 1 To UBound(r)'on clear les items du tableau
For j = 1 To UBound(r, 2): r(i, j) = ""
Next j
Next i
For i = 0 To UBound(k): r(i + 1, 1) = k(i): r(i + 1, 2) = it(i): Next
tblmapomme = r
End Function