J'ai reçu un fichier en pdf qui , en réalité, est un doc excel que je
voudrais travailler pour le comprendre.
Il s'agit de partager un demi terrain de foot (donc: 50m X 50m) en 2500
cases de 1 m².
Ensuite, et c'est là ma question: comment puis-je attribuer à chaque case un
numéro allant de 1 à 2500, mais de façon aléatoire, de manière à ce qu'il
n'y aie aucune suite logique.
Ex: le 1, 25,2000,789, ..... tout cela dans un carré de 50 cases X 50.
Alea jacta est !
Merci pour vos bonnes explications.
Au fait, existe-t-il un programme fiable pour transformer un pdf et revenir
en excel ?
Merci et bonne journée.
Jacques.
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Seulement pour le plaisir, cette procédure est au moins 3 fois plus rapide que la dernière. (0.15 secondes en moyenne chez moi)
'------------------------------------------------------------------------ Sub test() Dim NbNumber As Long, i As Long, V As Long Dim NbRow As Long, NbColumn As Long, Rg As Range Dim Trouve As Range, T(1 To 50, 1 To 50)
'Nombre de numéros à sortir au hasard sans doublon NbNumber = 2500
NbColumn = 1 NbRow = 1
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
'Nom de l'onglet de la feuille à adapter With Worksheets("Feuil1") Set Rg = .Range("A1:AX50") With Rg Do Randomize V = Int((NbNumber) * Rnd + 1) If Not Dic.Exists(V) Then Dic.Add V, V NbColumn = Dic.Count Mod 50 If NbColumn = 0 Then NbColumn = 50 T(NbRow, NbColumn) = V NbRow = NbRow + 1 Else T(NbRow, NbColumn) = V End If End If Loop Until Dic.Count >= NbNumber .Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T .EntireColumn.AutoFit Set Trouve = .Find(what: 00, LookIn:=xlValues, LookAt:=xlWhole) .ColumnWidth = Trouve.ColumnWidth .RowHeight = .Columns(1).Width .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End With Application.ScreenUpdating = True End Sub '------------------------------------------------------------------------
Seulement pour le plaisir, cette procédure est au moins 3 fois plus rapide
que la dernière.
(0.15 secondes en moyenne chez moi)
'------------------------------------------------------------------------
Sub test()
Dim NbNumber As Long, i As Long, V As Long
Dim NbRow As Long, NbColumn As Long, Rg As Range
Dim Trouve As Range, T(1 To 50, 1 To 50)
'Nombre de numéros à sortir au hasard sans doublon
NbNumber = 2500
NbColumn = 1
NbRow = 1
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
'Nom de l'onglet de la feuille à adapter
With Worksheets("Feuil1")
Set Rg = .Range("A1:AX50")
With Rg
Do
Randomize
V = Int((NbNumber) * Rnd + 1)
If Not Dic.Exists(V) Then
Dic.Add V, V
NbColumn = Dic.Count Mod 50
If NbColumn = 0 Then
NbColumn = 50
T(NbRow, NbColumn) = V
NbRow = NbRow + 1
Else
T(NbRow, NbColumn) = V
End If
End If
Loop Until Dic.Count >= NbNumber
.Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
.EntireColumn.AutoFit
Set Trouve = .Find(what: 00, LookIn:=xlValues, LookAt:=xlWhole)
.ColumnWidth = Trouve.ColumnWidth
.RowHeight = .Columns(1).Width
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Application.ScreenUpdating = True
End Sub
'------------------------------------------------------------------------
Seulement pour le plaisir, cette procédure est au moins 3 fois plus rapide que la dernière. (0.15 secondes en moyenne chez moi)
'------------------------------------------------------------------------ Sub test() Dim NbNumber As Long, i As Long, V As Long Dim NbRow As Long, NbColumn As Long, Rg As Range Dim Trouve As Range, T(1 To 50, 1 To 50)
'Nombre de numéros à sortir au hasard sans doublon NbNumber = 2500
NbColumn = 1 NbRow = 1
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
'Nom de l'onglet de la feuille à adapter With Worksheets("Feuil1") Set Rg = .Range("A1:AX50") With Rg Do Randomize V = Int((NbNumber) * Rnd + 1) If Not Dic.Exists(V) Then Dic.Add V, V NbColumn = Dic.Count Mod 50 If NbColumn = 0 Then NbColumn = 50 T(NbRow, NbColumn) = V NbRow = NbRow + 1 Else T(NbRow, NbColumn) = V End If End If Loop Until Dic.Count >= NbNumber .Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T .EntireColumn.AutoFit Set Trouve = .Find(what: 00, LookIn:=xlValues, LookAt:=xlWhole) .ColumnWidth = Trouve.ColumnWidth .RowHeight = .Columns(1).Width .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End With Application.ScreenUpdating = True End Sub '------------------------------------------------------------------------
isabelle
c'est le top, Denis, même pas une mili-seconde bravo! isabelle
c'est le top, Denis, même pas une mili-seconde
bravo!
isabelle
;-) ho que oui, on l'a eu dur, j'espère que les prédictions ne se confirmeront pas, http://www.meteomedia.com/nouvelles/articles/vortex-polaire-deforme-un-symptome-des-changements-climatiques/46213/ isabelle
Le 2015-02-27 19:25, MichD a écrit :
Merci Isabelle.
As-tu hâte que la température se réchauffe? ;-))
;-) ho que oui, on l'a eu dur, j'espère que les prédictions ne se confirmeront pas,
http://www.meteomedia.com/nouvelles/articles/vortex-polaire-deforme-un-symptome-des-changements-climatiques/46213/
isabelle
;-) ho que oui, on l'a eu dur, j'espère que les prédictions ne se confirmeront pas, http://www.meteomedia.com/nouvelles/articles/vortex-polaire-deforme-un-symptome-des-changements-climatiques/46213/ isabelle
