Tabelopslag og udvælgelse

Hej lasseo,

Jeg vil anbefale, du bruger filter funktionen på kolonne J i tabel A, her vælger du "Ja"

Nu trykker du på F5 og vælger "Speciel" - og herefter igen kun synelige celler

Nu kopier du og sætter det ind, hvor du vil have den nye tabel.

Samme øvelse gør du med Tabel B med "Nej" - den sætter du så ind under de andre poster i den nye tabel?

Håber det kan bruges

Mvh
Ransborg

Hej Ransborg,

Ja og nej. Jeg havde noget lignende, men da processen skal køres ofte, gælder - og af forholdsvis nye Excel-brugere - vil jeg gerne automatisere så meget som muligt.

Jeg håber andre har bedre bud - sikkert en macro?
/Lasseo

Avanceret filter kunne være en løsning - evt. lagt ind i en makro.

Jeg har ikke prøvet om det virker, men man kan lave en pivot-tabel ud fra flere områder.

Måske det kunne være en ide ?

Send evt. regnearket til jkatborg@yahoo.com med par kommentarer om hvad du vil se i den 3. tabel - så skal jeg teste om det virker ?

Den samlede opgave er kompleks at beskrive med flere kriterier for udvælgelse af poster, opslag for oversættelse og/eller tilføjelser af data og endelig formatering til præsentation. Derfor vil jeg gerne forsøge lidt videre inden jeg eventuelt laver en mail med ark til test - men jeg vil gerne forbeholde mig ret til senere at gøre brug af tilbuddet :o)

Har lige prøvet selv med et par regneark, som jeg selv havde :-( Det virker ikke.

Denne makro kan sikkert gøre det, men....
Hvilke kolonner ønskes overført ?
I eksemplet har jeg valgt kolonne 1,3,5,10,15,16,19 (a,c,e....)

Option Base 1

Sub testing()
Dim var1, var2, var3
Dim x As Integer, y As Integer, c1 As Integer, c2 As Integer
With Application.WorksheetFunction
  c1 = .CountIf(Sheet3.Range("J1:J500"), "JA")
  c2 = .CountIf(Sheet2.Range("O1:O500"), "NEJ")
End With
ReDim var3(c1 + c2 + 1, 7)
var1 = Sheet3.Range("A1:x500")
var2 = Sheet2.Range("a1:x500")
For x = 1 To UBound(var1, 1)
  If UCase(var1(x, 10)) = "JA" Then
  y = y + 1
    var3(y, 1) = var1(x, 1)
    var3(y, 2) = var1(x, 3)
    var3(y, 3) = var1(x, 5)
    var3(y, 4) = var1(x, 10)
    var3(y, 5) = var1(x, 15)
    var3(y, 6) = var1(x, 16)
    var3(y, 7) = var1(x, 19)
  End If
Next
For x = 1 To UBound(var2, 1)
  If UCase(var2(x, 15)) = "NEJ" Then
  y = y + 1
    var3(y, 1) = var2(x, 1)
    var3(y, 2) = var2(x, 3)
    var3(y, 3) = var2(x, 5)
    var3(y, 4) = var2(x, 10)
    var3(y, 5) = var2(x, 15)
    var3(y, 6) = var2(x, 16)
    var3(y, 7) = var2(x, 19)
  End If
Next
Sheet1.Range(Cells(2, 1), Cells(y + 1, 7)) = var3
End Sub

Tak til bak
Jeg forsøger at sætte de rigtige variable ind og teste....

Hej igen - opgaven er ikke glemt, selv om jeg er nød til at gå til og fra.
=>bak: Jeg har forsøgt at indsætte din macro og tilrette de forskellige variable, men jeg gør sikker et eller andet galt - i hvert fald fejler min afvikling. Kan det være pga. rækkeantallet i Sheet2 og sheet3, hvor jeg ikke kender antallet - men blot sætter det for højt for at sikre, jeg har alle linier med?

Lasse, jeg har lavet den lidt anderledes.
Du skal som før selv sætte dine kolonner ind.
Du skal også ændre der hvor der står Set sh1 = Worksheets(bla. bla) til navnene på dine egne ark.

Sub testing()
Dim var1, var2, var3
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("Navnet på arket, der skal kopieres over i")
Set sh2 = Worksheets("Navnet på Arket med kolonne O")
Set sh3 = Worksheets("Navnet på arket med kolonne J")

Dim x As Integer, y As Integer, c1 As Integer, c2 As Integer
With Application.WorksheetFunction
  c1 = .CountIf(sh3.Range("J1:J500"), "JA")
  c2 = .CountIf(sh2.Range("O1:O500"), "NEJ")
End With
ReDim var3(c1 + c2 + 1, 7)
var1 = sh3.Range("A1:x500")
var2 = sh2.Range("a1:x500")
For x = 1 To UBound(var1, 1)
  If UCase(var1(x, 10)) = "JA" Then
  y = y + 1
    var3(y, 1) = var1(x, 1)
    var3(y, 2) = var1(x, 3)
    var3(y, 3) = var1(x, 5)
    var3(y, 4) = var1(x, 10)
    var3(y, 5) = var1(x, 15)
    var3(y, 6) = var1(x, 16)
    var3(y, 7) = var1(x, 19)
  End If
Next
For x = 1 To UBound(var2, 1)
  If UCase(var2(x, 15)) = "NEJ" Then
  y = y + 1
    var3(y, 1) = var2(x, 1)
    var3(y, 2) = var2(x, 3)
    var3(y, 3) = var2(x, 5)
    var3(y, 4) = var2(x, 10)
    var3(y, 5) = var2(x, 15)
    var3(y, 6) = var2(x, 16)
    var3(y, 7) = var2(x, 19)
  End If
Next
sh1.Range(Cells(2, 1), Cells(y + 1, 7)) = var3
End Sub

Det lykkedes!
..at få hul igennem med bak's løsning.
Vil du lægge et svar, så jeg kan tildele points!

Tak for hjælpen til alle - filterfunktionerne kunne til nød også bruges, men det var den automatiske udvælgelse som bak's jeg søgte.

/lasseo

godt det lykkedes :-)