18. november 2010 - 08:51Der er
3 kommentarer og 1 løsning
Kopier kolonne eller række der opfylder betingelse
Hej
Excel 2003 - Windows XP - VBA
Jeg efterlyste på et tidspunkt en rutine til kopiering af kolonner der opfylder betingelse. Supertekst havde svaret med en BeforeDoubleClick rutine der kopierer alle kolonner der opfylder betingelse at være have samme værdi i samme kolonne, som værdien der dobbeltklikkes på. (se nederst)
Det fungerer fint og jeg har med held konvereteret nedenstående rutine til også at kunne lave samme trick på rækker.
Nu til spørgsmålet. Kan det lade sig gøre at kombinere BeforeDoubleClick rutinen med en funktion så man kan kombinere kopiering af kolonner eller rækker afhængig af om f.eks. CTRL holdes nede mens der dobbeltklikkes eller ej.
Dobbeltklik - så kopieres kolonner (rutine 1)
Dobbeltklik og CTRL samtidig holdes nede - så kopieres rækker (rutine 2)
Da jeg har styr på begge rutiner er det egenlig kun noget i stil med dette jeg efterlyser.
If BeforeDoubleClick and "CTRL pressed" then Rutine 2 Else Rutine 1 End If
******************************************************* Koden fra Supertekst herunder (kopiering af kolonner)
Indlægges på Ark1 (Højreklik på fanen - vis programkode) Aktiveres ved højreklik på ønskede værdi i ønskede række --------------------------------------------------------
Dim værdi As Variant, række As Long, tilKol As Byte Const startKolonne = 2 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) værdi = Target.Value Cancel = True
tilKol = startKolonne findværdi værdi, Target.Row
End Sub Private Sub findværdi(værdi, række) For kol = 1 To ActiveCell.SpecialCells(xlLastCell).Column If Cells(række, kol) = værdi Then kopierKolonne kol, tilKol End If Next kol End Sub Private Sub kopierKolonne(fraKol, tilKol) Columns(fraKol).Select Selection.Copy
Hos Computerworld it-jobbank er vi stolte af at fortsætte det gode partnerskab med folkene bag IT-DAY – efter vores mening Danmarks bedste karrieremesse for unge og erfarne it-kandidater.
Private Declare Function GetKeyState Lib "user32" _ (ByVal nVirtKey As Long) As Integer Const VK_CONTROL As Integer = &H11 'Ctrl Private Sub Worksheet_SelectionChange(ByVal Target As Range) If GetKeyState(VK_CONTROL) < 0 Then Ctrl = True Else Ctrl = False End if
If Ctrl = True Then Rutine 2 Else Rutine 1 End If End Sub
Men jeg ved dog ikke om CTRL er den bedste knap at sætte til det, da den normal vis vil tilføje den celle du trykker på, til den samlede markering i arket.
Du har ret i din betragtning omkring at CTRL er en uheldig taste at benytte grundet markerings issuet. Jeg bruger så ALT tasten istedet = &H12 - så virker det.
Jeg har tilføjet koden som vist herunder og det virker. Da jeg bruger beforedoubleclick på sheet'en undlader jeg SelectionChange(ByVal Target As Range)fra din kode - men bruger ellers den øvrige kode.
Tak for hjælpen - skriv et svar så du kan få pointene. :-)
Dim værdi As Variant, række As Long, tilKol As Byte Const startKolonne = 2 ' første del af ny kode ************************** Private Declare Function GetKeyState Lib "user32" _ (ByVal nVirtKey As Long) As Integer Const VK_CONTROL As Integer = &H12 'Alt ' ************************************************ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) værdi = Target.Value Cancel = True ' 2 del af ny kode ******************************* If GetKeyState(VK_CONTROL) < 0 Then ALT = True Else ALT = False End If
If ALT = True Then Range("BB1") = "Rutine 2" ' udfør rutine 2 Else Range("BB1") = "Rutine 1" ' udfør rutine 1 End If * *********************************************** Øvrig kode
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.
