VBA der konverterer "datamatrix" til "datatabel" med en værdi-kolonne

kan du oploade et eksempel her
http://gratisupload.dk
og sæt så linket ind, så vi kan finde den.

Skriv lige i en tekst i arket om hvad du ønsker.

Jeg vil kikke på det i aften.

Jeg sender imorgen. Har ikke adgang til filen da jeg ikke er på kontoret idag.
Mvh Line

Hej Kabbak
Jeg har sendt dig en intern besked.
Mvh Line

indtil nu, ser makroen sådan ud

Option Base 1 ' sørger for at alle variabler starter med 1
Public Sub LavDataark()
    Dim Rw As Long, I As Long, X As Long, Y As Long, A As Integer, Data1 As Variant, data2 As Variant, DataUD As Variant
   
    Application.ScreenUpdating = False ' så skærmen ikke opdateres
    Application.DisplayAlerts = False ' jeg vil ikke se alarmer
    Rw = ActiveSheet.UsedRange.Rows.Count ' finder antal rækker som er brugt i arket
    Data1 = Range(Cells(1, "A"), Cells(Rw, "M")) 'Henter projektnr, omkostninggruppe, kontogruppe osv, ind i en variabel, incl. overskrifter
    data2 = Range(Cells(1, "N"), Cells(Rw, "Y")) 'Henter omkostningstal i DKK for oktober til september, ind i en variabel, incl. overskrifter
    ReDim DataUD(Rw * 12, 15)
    On Error Resume Next ' hvis arket PivotData ikke findes vil den fejle, dette annulerer den fejl
    Worksheets("PivotData").Delete ' sletter arket "PivotData", hvis det findes
    On Error GoTo 0 ' normal fejl igen
   
    Worksheets.Add ' opretter nyt ark
    ActiveSheet.Name = "PivotData" ' navngiver det som  "PivotData"
   
    ' nu foregår resten i hukommelsen
    Y = 1 ' rækketæller for DataUD
     
    For I = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, I) = Data1(1, I) '  projektnr, omkostninggruppe, kontogruppe osv i første række
      Next
      DataUD(Y, 14) = "Måned" 'overskrift kolonne N
      DataUD(Y, 15) = "omkostninger" 'overskrift kolonne O
 
     
    For I = 2 To Rw ' antal rækker
    For X = 1 To 12 ' amtal værdi kolonnrt
    Y = Y + 1 ' rækketæller for DataUD
    DataUD(Y, 14) = Format(data2(1, X), "mmm") ' Måned
    DataUD(Y, 15) = data2(I, X) ' Beløb
    For A = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, A) = Data1(I, A) '  projektnr, omkostninggruppe, kontogruppe osv i resten af rækkerne
      Next
   
    Next
    Next
    Range("A1").Resize(UBound(DataUD, 1), UBound(DataUD, 2)) = DataUD ' Resizer området, så det passer til data
   
        Application.DisplayAlerts = True ' jeg vil gerne se alarmer igen
        Application.ScreenUpdating = True ' så skærmen opdateres igen
End Sub

Hej Kabbak

Super, det er præcis det jeg har brug for, og tak for forklaringerne på hver linie, selvom at jeg ikke forstår dem alle ;-)

men men men, kan jeg bede om et par ting mere???? Eller skal jeg oprette et nyt spørgsmål??

1) Istedet for at oprette en ny fane hver gang, kan filen så altid indeholde fanen, og kun indholdet i fanens kolonne F til AA slettes?

2) Kan jeg rette i koden så datene blive indsat i kolonne F og frem istedet for i kolonne A?

3) Jeg vil gerne tilføje nogle vlookup formler i kolonne A til E (derfor mine ønsker i step 1+2). Kan disse formler automatisk blive kopieret ned til dit definerede "Rw", altså så langt ned som der er rækker.

1. ja
2. ja
3. måske, men hvor skal de slå op,

Hvis du sender mappen retur med arket "PivotData" i, hvor du har skubbet data over til kolonne F og indsat dine formler i nogen af de første rækker, så ser vi.

Hov lige en ting mere. Du skriver:
DataUD(Y, 14) = Format(data2(1, X), "mmm") ' Måned

Men jeg har brug for at det stadig er en fuld dato der står, fx 01-03-2013 istedet for bare "Mar".
Kan du rette det til??

DataUD(Y, 14) =data2(1, X) ' dato

fil er sendt :-)

så blev det til.:

Option Base 1 ' sørger for at alle variabler starter med 1
Public Sub LavDataark()
    Dim Rw As Long, I As Long, X As Long, Y As Long, A As Integer
    Dim Data1 As Variant, data2 As Variant, DataUD As Variant, DataFormel As Variant
    Application.ScreenUpdating = False ' så skærmen ikke opdateres
    Application.DisplayAlerts = False ' jeg vil ikke se alarmer
    Rw = ActiveSheet.UsedRange.Rows.Count ' finder antal rækker som er brugt i arket
    Data1 = Range(Cells(1, "A"), Cells(Rw, "M")) 'Henter projektnr, omkostninggruppe, kontogruppe osv, ind i en variabel, incl. overskrifter
    data2 = Range(Cells(1, "N"), Cells(Rw, "Y")) 'Henter omkostningstal i DKK for oktober til september, ind i en variabel, incl. overskrifter
    ReDim DataUD((Rw * 12) - 11, 15)
    ReDim DataFormel((Rw * 12) - 11, 6)
    Worksheets("PivotData").Activate ' aktiverer arket "PivotData", hvis det findes
    Cells.ClearContents ' tømmer arket
   
    ' nu foregår resten i hukommelsen
    Y = 1 ' rækketæller for DataUD
     
    For I = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, I) = Data1(1, I) '  projektnr, omkostninggruppe, kontogruppe osv i første række
      Next
      DataUD(Y, 14) = "Dato" 'overskrift kolonne N
      DataUD(Y, 15) = "omkostninger" 'overskrift kolonne O
 
     
    For I = 2 To Rw ' antal rækker
    For X = 1 To 12 ' amtal værdi kolonnrt
    Y = Y + 1 ' rækketæller for DataUD
    DataUD(Y, 14) = data2(1, X) ' Dato
    DataUD(Y, 15) = data2(I, X) ' Beløb
    For A = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, A) = Data1(I, A) '  projektnr, omkostninggruppe, kontogruppe osv i resten af rækkerne
      Next
   
    Next
    Next
   
    ' først overskrifter til formler
    'Gov Program Cat PA status  Clarity ID  Type
DataFormel(1, 1) = "Gov"
      DataFormel(1, 2) = "Program"
      DataFormel(1, 3) = "Cat"
      DataFormel(1, 4) = "PA status"
      DataFormel(1, 5) = "Clarity ID"
      DataFormel(1, 6) = "Type"
    ' nu formler
    For I = 2 To UBound(DataFormel, 1)
      DataFormel(I, 1) = "=VLOOKUP(RC7,Project_Details,5,FALSE)"
      DataFormel(I, 2) = "=VLOOKUP(RC7,Project_Details,6,FALSE)"
      DataFormel(I, 3) = "=VLOOKUP(RC7,Project_Details,7,FALSE)"
      DataFormel(I, 4) = "=VLOOKUP(RC7,Project_Details,8,FALSE)"
      DataFormel(I, 5) = "=VLOOKUP(RC7,Project_Details,9,FALSE)"
      DataFormel(I, 6) = "=VLOOKUP(RC7,Project_Details,3,FALSE)"
    Next
   
    Range("G1").Resize(UBound(DataUD, 1), UBound(DataUD, 2)) = DataUD ' Resizer området, så det passer til data
    Range("A1").Resize(UBound(DataFormel, 1), UBound(DataFormel, 2)) = DataFormel ' Resizer området, så det passer til Formler
   
        Application.DisplayAlerts = True ' jeg vil gerne se alarmer igen
        Application.ScreenUpdating = True ' så skærmen opdateres igen
End Sub

Hej igen Kabbak


Når jeg åbner filen jeg har fået tilsendt fra dig, indeholder celle A2 i fanen PivotData følgende formel som virker: =VLOOKUP($G2;Project_Details;5;FALSE. Og her bliver henvisningen til "Lookup_value" i formlen ændret til den rigtige linie i alle celler.

Hvis jeg så efterfølgende afspiller VBA koden selv, kommer alle celler i kolonne A til F til at vise "#N/A" og formlen er: =VLOOKUP(RC7;Project_Details;5;FALSE).
Og her ændres "Lookup-value" ikke i hver linie, den hedder altid RC7....

Lige et spørgsmål: Tror du det vil være realistisk at afspille denne kode på 800.000 linier?? Vlookup formler er jo normalt ikke så godt på mange linier......

Det er godt nok mange linjer.
Hvis du selv skriver formlen, virker den så?.
Prøv at optage en makro, mens du skriver formlen, se om den er forskellig, fra den i koden.

jeg har nu lavet koden om så det er koden der finder dine værdier, så ingen formler.

Option Base 1 ' sørger for at alle variabler starter med 1
Public Sub LavDataark()
    Dim Rw As Long, I As Long, X As Long, Y As Long, A As Integer
    Dim Data1 As Variant, data2 As Variant, DataUD As Variant, DataFormel As Variant
    Application.ScreenUpdating = False ' så skærmen ikke opdateres
    Application.DisplayAlerts = False ' jeg vil ikke se alarmer
    Rw = ActiveSheet.UsedRange.Rows.Count ' finder antal rækker som er brugt i arket
    Data1 = Range(Cells(1, "A"), Cells(Rw, "M")) 'Henter projektnr, omkostninggruppe, kontogruppe osv, ind i en variabel, incl. overskrifter
    data2 = Range(Cells(1, "N"), Cells(Rw, "Y")) 'Henter omkostningstal i DKK for oktober til september, ind i en variabel, incl. overskrifter
    ReDim DataUD((Rw * 12) - 11, 15)
    ReDim DataFormel((Rw * 12) - 11, 6)
    Worksheets("PivotData").Activate ' aktiverer arket "PivotData", hvis det findes
    Cells.ClearContents ' tømmer arket
   
    ' nu foregår resten i hukommelsen
    Y = 1 ' rækketæller for DataUD
     
    For I = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, I) = Data1(1, I) '  projektnr, omkostninggruppe, kontogruppe osv i første række
      Next
      DataUD(Y, 14) = "Dato" 'overskrift kolonne N
      DataUD(Y, 15) = "omkostninger" 'overskrift kolonne O
 
     
    For I = 2 To Rw ' antal rækker
    For X = 1 To 12 ' amtal værdi kolonnrt
    Y = Y + 1 ' rækketæller for DataUD
    DataUD(Y, 14) = data2(1, X) ' Dato
    DataUD(Y, 15) = data2(I, X) ' Beløb
    For A = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, A) = Data1(I, A) '  projektnr, omkostninggruppe, kontogruppe osv i resten af rækkerne
      Next
   
    Next
    Next
   
    ' først overskrifter til formler
    'Gov Program Cat PA status  Clarity ID  Type
DataFormel(1, 1) = "Gov"
      DataFormel(1, 2) = "Program"
      DataFormel(1, 3) = "Cat"
      DataFormel(1, 4) = "PA status"
      DataFormel(1, 5) = "Clarity ID"
      DataFormel(1, 6) = "Type"
    ' nu formler
    For I = 2 To UBound(DataFormel, 1)
      DataFormel(I, 1) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 5, False)
      DataFormel(I, 2) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 6, False)
      DataFormel(I, 3) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 7, False)
      DataFormel(I, 4) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 8, False)
      DataFormel(I, 5) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 9, False)
      DataFormel(I, 6) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 3, False)
    Next
   
    Range("G1").Resize(UBound(DataUD, 1), UBound(DataUD, 2)) = DataUD ' Resizer området, så det passer til data
    Range("A1").Resize(UBound(DataFormel, 1), UBound(DataFormel, 2)) = DataFormel ' Resizer området, så det passer til Formler
   
        Application.DisplayAlerts = True ' jeg vil gerne se alarmer igen
        Application.ScreenUpdating = True ' så skærmen opdateres igen
End Sub

Det er helt fantastisk, og den er jo SUPER hurtig. Jeg kunne ikke være mere tilfreds :-)

Kan jeg få dig til at markere hvor det er jeg skal rette i koden når jeg nu i næste måned kunne finde på at ville have en kolonne mere med formler??
Jeg er med på at jeg skal oprette overskrift og formel til den nye kolonne, men jeg kan ikke helt gennemskue hvad jeg skal rette i koden ovenover for at det kommer til at virke.

Og tusinde tak for din hjælp kabbak.

Så håber jeg at du måske også får tid til at hjælpe mig med mit andet spørgsmål: http://www.eksperten.dk/spm/979219

:D

1.
du skal rykke dine data lige så mange kolonner til højre som du vil indsætte kolonner med formler,

så "G1" skal rettes til "H1", hvis det er en kolonne

  Range("G1").Resize(UBound(DataUD, 1), UBound(DataUD, 2)) = DataUD ' Resizer området, så det passer til data
2.
  ReDim DataFormel((Rw * 12) - 11, 6)
skal rettes til
ReDim DataFormel((Rw * 12) - 11, 7)

og under denne

      DataFormel(I, 6) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 3, False)

sætter du en ny linje
      DataFormel(I, 7) = Application.WorksheetFunction.VLookup(DataUD(I, 1), Range("Project_Details"), 3, False)

3 tallet retter du til den kolonne den skal hente fra

så skulle det virke.

Tusinde tak igen Kabbak, denne VBA er en kæmpe hjælp for mig :-)

Hej igen Kabbak
Jeg får nu en run-time error 1004 når jeg forsøger at kører koden i min fil.
Jeg har sendt dig en email med filen. Håber du vil kigge på den.

rettet kode.

Option Base 1 ' sørger for at alle variabler starter med 1

Sub LavDataark()
    Dim Rw As Long, I As Long, X As Long, Y As Long, A As Integer
    Dim Data1 As Variant, Data2 As Variant, DataUD As Variant, DataFormel As Variant, Opslag As Variant
    Application.ScreenUpdating = False ' så skærmen ikke opdateres
    Application.DisplayAlerts = False ' jeg vil ikke se alarmer
    Application.StatusBar = "Læser data"
    Sheets("Datamatrix_Cost").Select
   
    Rw = ActiveSheet.UsedRange.Rows.Count ' finder antal rækker som er brugt i arket
    Data1 = Range(Cells(1, "A"), Cells(Rw, "M")) 'Henter projektnr, omkostninggruppe, kontogruppe osv, ind i en variabel, incl. overskrifter
    Data2 = Range(Cells(1, "N"), Cells(Rw, "Y")) 'Henter omkostningstal i DKK for oktober til september, ind i en variabel, incl. overskrifter
    ReDim DataUD((Rw * 12) - 11, 15)
    ReDim DataFormel((Rw * 12) - 11, 6)
    Worksheets("Datatable_Cost").Activate ' aktiverer arket "Datatable_Cost", hvis det findes
    Cells.ClearContents ' tømmer arket
   
    ' nu foregår resten i hukommelsen
    Y = 1 ' rækketæller for DataUD
      Application.StatusBar = "Laver omkostnings data"
    For I = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, I) = Data1(1, I) '  projektnr, omkostninggruppe, kontogruppe osv i første række
      Next
      DataUD(Y, 14) = "Dato" 'overskrift kolonne N
      DataUD(Y, 15) = "omkostninger" 'overskrift kolonne O
 
     
    For I = 2 To Rw ' antal rækker
    For X = 1 To 12 ' amtal værdi kolonnrt
    Y = Y + 1 ' rækketæller for DataUD
    DataUD(Y, 14) = Data2(1, X) ' Dato
    DataUD(Y, 15) = Data2(I, X) ' Beløb
    For A = 1 To UBound(Data1, 2) ' gennemgang af kolonner i Data1
      DataUD(Y, A) = Data1(I, A) '  projektnr, omkostninggruppe, kontogruppe osv i resten af rækkerne
      Next
   
    Next
    Next
 
    ' først overskrifter til formler
    'Gov Program Cat PA status  Clarity ID  Type
    Application.StatusBar = "laver Opslag i arket 'Project_Details'"
DataFormel(1, 1) = "Gov"
      DataFormel(1, 2) = "Program"
      DataFormel(1, 3) = "Cat"
      DataFormel(1, 4) = "PA status"
      DataFormel(1, 5) = "Clarity ID"
      DataFormel(1, 6) = "Type"
      Opslag = Range("Project_Details") ' læser aområdet 'Project_Details' ind i en variabel
    ' nu formler
     
    For I = 2 To UBound(DataFormel, 1)
        For X = 1 To UBound(Opslag, 1)
            If DataUD(I, 1) = Opslag(X, 1) Then
                DataFormel(I, 1) = Opslag(X, 5)
                DataFormel(I, 2) = Opslag(X, 6)
                DataFormel(I, 3) = Opslag(X, 7)
                DataFormel(I, 4) = Opslag(X, 8)
                DataFormel(I, 5) = Opslag(X, 9)
                DataFormel(I, 6) = Opslag(X, 3)
                Exit For
                End If
        Next
           
    Next

    Application.StatusBar = "Skriver data i arket 'Datatable_Cost'"
    Range("G1").Resize(UBound(DataUD, 1), UBound(DataUD, 2)) = DataUD ' Resizer området, så det passer til data
    Range("A1").Resize(UBound(DataFormel, 1), UBound(DataFormel, 2)) = DataFormel ' Resizer området, så det passer til Formler
   
        Application.DisplayAlerts = True ' jeg vil gerne se alarmer igen
        Application.ScreenUpdating = True ' så skærmen opdateres igen
        Application.StatusBar = "FÆRDIG"
End Sub

Super, så virker det igen. Tak for hjælpen.