1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
|
Public Type RLine
cle As String
ORDNO As String
FOLDERNO As String
Testcode As String
METAL As String * 6
FINAL As String * 6
End Type
Private Sub rapport()
Dim NbrLignes As Integer
Dim RapportLine As RLine
Dim RapportLines() As RLine
Sheets("feuil3").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("J2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
NbrLignes = Selection.Rows.Count
For i = 0 To NbrLignes
ReDim Preserve RapportLines(i + 1)
RapportLine.cle = Sheets("Feuil3").Range("F1").Offset(i + 1, 0).Value
RapportLine.ORDNO = Sheets("Feuil3").Range("J1").Offset(i + 1, 0).Value
RapportLine.FOLDERNO = Sheets("Feuil3").Range("K1").Offset(i + 1, 0).Value
RapportLine.Testcode = Sheets("Feuil3").Range("L1").Offset(i + 1, 0).Value
RapportLine.METAL = Sheets("Feuil3").Range("M1").Offset(i + 1, 0).Value
RapportLine.FINAL = Sheets("Feuil3").Range("M1").Offset(i + 1, 0).Value
RapportLines(i) = RapportLine
Next
Dim Analyse As String
Dim TabAnalyse
Entete = "cle,ORDNO,FOLDERNO,TESTCODE,Al,B,Ca,Cl-,Co,Cr,Cu,Fe,Four,Hf,Mg,Mn,Mo,N,Ni,O,P,Si,Ti,V"
TabENTETE = Split(Entete, ",")
For i = 0 To UBound(TabENTETE)
Sheets("Feuil1").Range("A1").Offset(0, i).Value = TabENTETE(i)
Next
For i = 1 To UBound(RapportLines)
Sheets("Feuil1").Range("A1").Offset(i + 1, 0).Value = RapportLines(i).cle
Sheets("Feuil1").Range("B1").Offset(i + 1, 0).Value = RapportLines(i).ORDNO
Sheets("Feuil1").Range("C1").Offset(i + 1, 0).Value = RapportLines(i).FOLDERNO
Sheets("Feuil1").Range("D1").Offset(i + 1, 0).Value = RapportLines(i).Testcode
For j = 0 To 19
If RapportLines(i).METAL = Sheets("Feuil1").Range("E1").Offset(0, j).Value Then
Sheets("Feuil1").Range("E1").Offset(i + 1, j).Value = RapportLines(i).FINAL
End If
Next j
Next i
Sheets("feuil1").range("A1").select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Columns.AutoFit
End Sub |
Partager