11. december 2009 - 11:08Der er
5 kommentarer og 1 løsning
Sammenskrivning af to macroer
Hejsa
Er der en ørn som kan sammenskrive disse to macroer til en:
1) Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Descrip As String Dim thisrow As String Dim r As Double Dim c As Double
c = Selection.Columns.Count r = Selection.Rows.Count thisrow = Target.row
If c > 1 Or r > 1 Or Target.column <> 10 Or Target.Cells.Count <> 1 Then Exit Sub End If
If IsError(Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False)) And Target.column = 10 Then Range("K" & thisrow).Value = "" Exit Sub End If
If Target.Cells.Count = 1 Then Descrip = Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False) Range("K" & thisrow).Value = Descrip End If
End Sub
----------------------------------------------------------------- 2) Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Competences As String Dim thisrow As String Dim r As Double Dim c As Double
c = Selection.Columns.Count r = Selection.Rows.Count thisrow = Target.row
If c > 1 Or r > 1 Or Target.column <> 6 Or Target.Cells.Count <> 1 Then Exit Sub End If
If IsError(Application.VLookup(Range("G" & thisrow).Value, Worksheets("Resource Pool").Range("$B$3:$C$2000"), 2, False)) And Target.column = 3 Then Range("H" & thisrow).Value = "" Exit Sub End If
If Target.Cells.Count = 1 Then Descrip = Application.VLookup(Range("G" & thisrow).Value, Worksheets("Projects").Range("$B$3:$C$2000"), 2, False) Range("H" & thisrow).Value = Competences End If
End Sub --------------------------------------------------
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Hvis de to koder er ok, kan du så ikke bruge løsningen fra tidligere spørgsmål http://www.eksperten.dk/spm/895134 Put de 2 kodestumper i 2 subs, og kald de 2 subs i Worksheet_Change
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Call KolonneJ Call KolonneG End sub
'1) flyttes til et modul Sub KolonneJ() Dim Descrip As String Dim thisrow As String Dim r As Double Dim c As Double
c = Selection.Columns.Count r = Selection.Rows.Count thisrow = Target.row
If c > 1 Or r > 1 Or Target.column <> 10 Or Target.Cells.Count <> 1 Then Exit Sub End If
If IsError(Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False)) And Target.column = 10 Then Range("K" & thisrow).Value = "" Exit Sub End If
If Target.Cells.Count = 1 Then Descrip = Application.VLookup(Range("J" & thisrow).Value, Worksheets("Projects").Range("$B$3:$G$2000"), 6, False) Range("K" & thisrow).Value = Descrip End If
End Sub
'2) flyttes til samme modul Sub KolonneG() Dim Competences As String Dim thisrow As String Dim r As Double Dim c As Double
c = Selection.Columns.Count r = Selection.Rows.Count thisrow = Target.row
If c > 1 Or r > 1 Or Target.column <> 6 Or Target.Cells.Count <> 1 Then Exit Sub End If
If IsError(Application.VLookup(Range("G" & thisrow).Value, Worksheets("Resource Pool").Range("$B$3:$C$2000"), 2, False)) And Target.column = 3 Then Range("H" & thisrow).Value = "" Exit Sub End If
If Target.Cells.Count = 1 Then Descrip = Application.VLookup(Range("G" & thisrow).Value, Worksheets("Projects").Range("$B$3:$C$2000"), 2, False) Range("H" & thisrow).Value = Competences End If
Prøv at lægge dem i 2 moduler, så der ikke er noget der bliver rodet sammen.
Synes godt om
Ny brugerNybegynder
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.
