Avatar billede KenneyD71 Nybegynder
23. maj 2015 - 19:14 Der er 8 kommentarer og
1 løsning

VBA: Opret tabel eller navngivent område ud fra select Region

Jeg har brug for en makro, der enten
1) opretter en tabel med overskrifter eller
2) laver en navngivning af det markerede område.

Når jeg prøver det, får jeg specifikke referencer - og det er nogo, så rangen ændrer sig hele tiden.

Når jeg prøver får jeg nedenstående (3 forskellige) resultater.

Sub BuildTable()
'
' BuildTable Macro
'

'
    Selection.CurrentRegion.Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$1427"), , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
End Sub

Sub BuildTableVS02()
'
' BuildTableVS02 Macro
'

'
    Selection.CurrentRegion.Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$1427"), , xlYes).Name = _
        "Table3"
    ActiveCell.Range("Table3[#All]").Select
End Sub


Sub NameBunkeTable()
'
' NameBunkeTable Macro
'

'
    ActiveCell.Offset(-9, -5).Range("A1:G1427").Select
    ActiveCell.Activate
    ActiveWorkbook.Names.Add Name:="BunkeTabel", RefersToR1C1:= _
        "=Ekspo_bunke!R1C1:R1427C7"
    ActiveWorkbook.Names("BunkeTabel").Comment = ""
End Sub
Avatar billede kabbak Professor
23. maj 2015 - 22:10 #1
Sub BuildTable()
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$1427"), , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
End Sub

Sub BuildTableVS02()
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$1427"), , xlYes).Name = _
        "Table3"
  ActiveCell.Range("Table3[#All]").Select
End Sub


Sub NameBunkeTable()
        ActiveWorkbook.Names.Add Name:="BunkeTabel", RefersToR1C1:="=Ekspo_bunke!R1C1:R1427C7"
       
  ActiveWorkbook.Names("BunkeTabel").Comment = ""
End Sub


Den sidste linie i hver kode, får jeg fejl på, måske fordi jeg kun har Excel 2003 på denne pc.
Avatar billede KenneyD71 Nybegynder
23. maj 2015 - 22:27 #2
Problemet er ..."..Range("$A$1:$G$1427"),.....

Næste gang er ranged noget andet - så der kan ikke i koden være en specific cellereference.
Avatar billede natkatten Mester
23. maj 2015 - 22:31 #3
Prøv med denne:

Sub LavTabel()

Dim ark As Worksheet
Dim sidsteRk As Long
Dim sidsteKol As Long

Set ark = ActiveSheet
sidsteRk = Cells(Rows.Count, 1).End(xlUp).Row
sidsteKol = Cells(1, Columns.Count).End(xlToLeft).Column

If IsEmpty(Cells(1, 1)) Then
MsgBox "Der er ingen værdi i celle A1." & vbNewLine & _
"Makroen forudsætter dette."
Else
    ark.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), _ Cells(sidsteRk, sidsteKol)), , xlYes).Name _
= "Tabel" & Format(Now(), "yyyymmddhhmmss")
End If

End Sub
Avatar billede natkatten Mester
23. maj 2015 - 22:33 #4
Hmm. Det gik galt med linjeskiftene. Jeg forsøgte ellers at undgå dette med _ Håber at du selv kan fixe dette ved eventuelt at lave en søg og erstat på dem.
Avatar billede natkatten Mester
23. maj 2015 - 22:37 #5
Sub LavTabel()

Dim ark As Worksheet
Dim sidsteRk As Long
Dim sidsteKol As Long

Set ark = ActiveSheet
sidsteRk = Cells(Rows.Count, 1).End(xlUp).Row
sidsteKol = Cells(1, Columns.Count).End(xlToLeft).Column

If IsEmpty(Cells(1, 1)) Then
MsgBox "Der er ingen værdi i celle A1." & vbNewLine & "Makroen forudsætter dette."
Else
    ark.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(sidsteRk, sidsteKol)), , _
    xlYes).Name = "Tabel" & Format(Now(), "yyyymmddhhmmss")
End If

End Sub
Avatar billede KenneyD71 Nybegynder
24. maj 2015 - 07:04 #6
Tak for svaret, Natkatten.

Det var lige hvad jeg havde brug for.

Giv dig selv nogle point. og glem heller ikke at gå til
http://www.eksperten.dk/spm/1003440 og hent de point du ikke fik sidste gang du hjalp mig.
Avatar billede natkatten Mester
24. maj 2015 - 07:49 #7
Et svar - og lægger også svar på det andet spørgsmål :-)
Avatar billede KenneyD71 Nybegynder
24. maj 2015 - 09:38 #8
Tak skal du have, natkatten.

Sætter pris på din hjælp og kompetencer.
Avatar billede store-morten Ekspert
24. maj 2015 - 11:51 #9
Kort:
Sub BuildTable()
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).Name = _
        "Tabel1"
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

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