Avatar billede Helga Novice
09. marts 2017 - 14:44 Der er 1 kommentar og
1 løsning

VB makro til at kopiere bruge definerede kolonner via arrayet

Hej alle sammen,
Jeg vil gerne oprette en makro i VBA som vil indtage et stort datasæt ind et array, bagefter vil arrayet blive resized til et nyt hvor kolonner i bruger definerede rækkefølge vil indsættes tilbage til et nyt faneblad.
Det oprindelige datasæt er på A1:AW størrelsen. Det sidste række-celle-nummer er altid ukendt.
De kolonner som jeg gerne vil sortere med til det nye faneblad er (13, 34, 28, 35, 40, 37) i det rå data.
Tabellen i det nye faneblad skal starte fra A1:F, hvor den første række står for kolonners navne (som jeg også har svært at få til at virke i den anden vba-kode nedenfor).
Jeg prøvede at kopiere-indsætte kolonner bare direkte uden at bruge arrays men pc?en går i stå da det datasæt er virkelige stort. Så nedenstående virker problematisk.
Sub CreateTabel2()

Dim wNew As Worksheet
Dim wCurrent As Worksheet
Dim mData As Range
Dim c As Range

Set wCurrent = Sheets("test")
Set mData = Range("A1:AW" & Range("AW" & Rows.Count).End(xlUp).Row)
Set wNew = Worksheets.Add
   
For Each c In mData
    wCurrent.Range("M" & c.Row).Copy Destination:=wNew.Range("A" & c.Row)
    wCurrent.Range("AH" & c.Row).Copy Destination:=wNew.Range("B" & c.Row)
    wCurrent.Range("AB" & c.Row).Copy Destination:=wNew.Range("C" & c.Row)
    wCurrent.Range("AI" & c.Row).Copy Destination:=wNew.Range("D" & c.Row)
    wCurrent.Range("AN" & c.Row).Copy Destination:=wNew.Range("E" & c.Row)
    wCurrent.Range("AK" & c.Row).Copy Destination:=wNew.Range("F" & c.Row)
Next
End Sub

Så tænkte jeg at anvende så noget i nedenstående retning, problemet er bare at jeg tidligere arbejdede kun men redimentionering af arrays med den oprindelige rækkefølge og have det svært at kopiere de bestemte kolonner. Så det bedste jeg har fundet indtil videre er at indsætte kun kolonne 13 men dette er ikke i fra A1 i det nye faneblad.
Hvis der er nogen der kan hjælpe med, så vil det være simpelthen fantastisk, da jeg er så tabt her. På forhånd tak.

Sub KopiDataSheet()

Dim lRow As Long
Dim lCol As Long
Dim rInputTable As Range  'Inputtabellen
Dim rTarget As Range      'Outputtabellen
Dim arInput()              'Array med inputtabellen
Dim arOutput()            'Array til outputtabellen
Dim vPattern As Variant

Set rInputTable = Range("A1").CurrentRegion
arInput = rInputTable.Value
Set rInputTable = Nothing
ReDim arOutput(1 To UBound(arInput), 1 To UBound(arInput, 2))

For lRow = 1 To UBound(arInput)
      For lCol = 1 To UBound(arInput, 2)
        If lCol = 13 Then
        arOutput(lRow, lCol) = arInput(lRow, lCol)
        End If
      Next
Next

Worksheets.Add
Set rTarget = Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2))
rTarget.Value = arOutput

End Sub
Avatar billede kabbak Professor
09. marts 2017 - 17:18 #1
Option Base 1
Sub KopiDataSheet()

    Dim lRow As Long
    Dim Col As Long
    Dim rInputTable As Variant  'Inputtabellen
    Dim rTarget() As Variant    'Outputtabellen
    Dim Colvalg As Variant    ' kolonnerækkefølgen
    Colvalg = Array(13, 34, 28, 35, 40, 37) ' dine kolonner som skal overføres til nyt ark

    rInputTable = ActiveSheet.UsedRange
    ReDim arOutput(UBound(rInputTable, 1), UBound(Colvalg))

    For lRow = 1 To UBound(rInputTable)
        For Col = 1 To UBound(Colvalg)

            arOutput(lRow, Col) = rInputTable(lRow, Colvalg(Col))
        Next
    Next

    Worksheets.Add
    Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2)) = arOutput

End Sub
Avatar billede Helga Novice
09. marts 2017 - 19:14 #2
Jeg er meget taknemlig for dit svar - i dag har jeg knoklet på arbejdet for at få denne makro til at virke da jeg skal bearbejde lignede datasætter på forskellige varer grupper. En stor tak - det virker udenmærket.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester