Avatar billede Klaus888 Nybegynder
01. august 2012 - 14:12 Der er 1 kommentar

Excel Problem (VBA): Ved bestemte værdier i Kollone B, skal hele rækken kopieres

Hej Eksperter,

jeg står med et problem som jeg har svært ved at finde løsningen på. Vil lige prøve at forklare det så grundigt jeg kan.

I mit regneark har jeg to faner (Fane 1 og Fane 2)

I Fane 1 kan man ned af kollone B vælge at skrive 3 forskelige tal (10, 20 og 30)

Hvis man eksempelvis i Fane 1 indtaster følgende tal(ned af Kollone B)

10                                (Skrives i række 27)
20                                (Skrives i række 28)
20                                (Skrives i række 29)
30                                (Skrives i række 30)
10                                (Skrives i række 31)
30                                (Skrives i række 32)
20                                (Skrives i række 33)
Osv....

Så vil jeg gerne have at den i fane 2 automatisk kopierer over og sortere dem. Således at der kommer til at stå

(Her er en overskrift som beskriver dem hvor jeg vil skrive 10)
10                                (Værdien fra række 27)
10                                (Værdien fra række 31)

(Her er en overskrift som beskriver dem hvor jeg vil skrive 20)
20                                (Værdien fra række 28)
20                                (Værdien fra række 29)
20                                (Værdien fra række 33)

(Her er en overskrift som beskriver dem hvor jeg vil skrive 30)
30                                (Værdien fra række 30)
30                                (Værdien fra række 32)

Den skal ikke bare kopiere tallene i kollone B, men hele rækken over, og der skal ikke være tomme linjer mellem tallene.

Håber det er til at forstå, og at nogen kan hjælpe. Det er ret svært, så smider 100 point til den som kan svare på det :)
Avatar billede Mads Larsen Nybegynder
01. august 2012 - 14:47 #1
Hej Klaus

Jeg er ikke helt sikker på om det er sådan her du mener.
Men her er en idé til hvordan det kunne gøres.

Sub SorterTilFane2()

Dim StartRange As Range
Set StartRange = Range("B27")

Sheets("Ark1").Select
StartRange.Select

Overskrift10 = "Her er tal 10"
Overskrift20 = "Her er tal 20"
Overskrift30 = "Her er tal 30"

i = 1

Do Until Len(ActiveCell.Text) = 0
  If ActiveCell.Value = 10 Or ActiveCell.Value = 20 Or ActiveCell.Value = 30 Then
        ActiveCell.EntireRow.Copy
        Sheets("Ark2").Rows(i).Insert Shift:=xlDown
  End If
  ActiveCell.Offset(1, 0).Select
Loop
Application.CutCopyMode = False

Sheets("Ark2").Select
Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("B1").Select

Dim X10 As Boolean
Dim X20 As Boolean
Dim X30 As Boolean

Do Until Len(ActiveCell.Text) = 0
    If ActiveCell.Value = 10 Then
        If X10 = False Then
            ActiveCell.EntireRow.Insert Shift:=xlDown
            ActiveCell = Overskrift10
        End If
        X10 = True
    End If
   
    If ActiveCell.Value = 20 Then
        If X20 = False Then
            ActiveCell.EntireRow.Insert Shift:=xlDown
            ActiveCell = Overskrift20
        End If
        X20 = True
    End If
   
    If ActiveCell.Value = 30 Then
        If X30 = False Then
            ActiveCell.EntireRow.Insert Shift:=xlDown
            ActiveCell = Overskrift30
        End If
        X30 = True
    End If

ActiveCell.Offset(1, 0).Select
Loop


End Sub
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
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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