03. maj 2007 - 14:08Der er
2 kommentarer og 1 løsning
Udskrive kommentarer fra regneark sammen med udtræk
I ark1 har jeg vandret datoer og lodret vognnumre. Altså en vagtplan. I ark2 kan jeg ved at indtaste en dato, få den pågældende dags vogne frem på ark2 i rækkefølge lodret (sammen med nogle postnumre, som tages fra ark2). I ark1 har jeg indsat kommentarer, som jeg gerne vil have udskrevet samtidigt, så vognnumrene står lodret og kommentarerne lodret i kolonne f ved siden af den vogn, der er kommenatrer til. Jeg mangler altså kun modulet til at få kommentarerne med, kan man indsætte et sådan?
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim kommentar As String Dim Kol, t, r If Intersect(Target, Range("C5")) Is Nothing Then Exit Sub If Target > DateSerial(2007, 6, 17) Then GoTo Uge25
Kol = Application.Match(Target, Sheets("Ark1-1").Range("A3:FM3"), 0) 'find aktuel kolonne Cells(1, 1) = Kol ' Slet evt. denne linie når du har testet koden Range("D6:D32") = "" 'rset udtræk For t = 4 To 29 ' Rækker i dit skema
Rem Slet gl. kommentarer If t = 4 Then Range("F6:F29").ClearContents End If
r = Cells(40, 4).End(xlUp).Row + 1 ' finder næste tomme celle i udttræk
If Sheets("Ark1-1").Cells(t, Kol) = "" Then Cells(r, 4) = Sheets("Ark1-1").Cells(t, 1) Rem Slet variablen "kommentar" kommentar = "" Rem Hvis ingen kommentar i cellen - så fortsæt On Error Resume Next
Rem hent kommentar fra cellen kommentar = Sheets("Ark1-1").Cells(t, Kol).Comment.Text
Rem hvis kommentar findes - fjern den første linie If kommentar <> "" Then kommentar = fjernLinie1(kommentar) End If Cells(r, 6) = kommentar End If Next GoTo ud
Uge25: Kol = Application.Match(Target, Sheets("Ark1-1").Range("A30:FM30"), 0) 'find aktuel kolonne Cells(2, 1) = Kol ' Slet evt. denne linie når du har testet koden Range("D6:D32") = "" 'reset udtræk For t = 4 To 29 ' Rækker i dit skema r = Cells(40, 4).End(xlUp).Row + 1 ' finder næste tomme celle i udttræk If Sheets("Ark1-1").Cells(t, Kol) = "" Then Cells(r, 4) = Sheets("Ark1-1").Cells(t, 1) Next
ud: End Sub Private Function fjernLinie1(kommentar) Dim p p = InStr(kommentar, Chr(10)) If p > 0 Then fjernLinie1 = Mid(kommentar, p + 1) Else fjernLinie1 = kommentar End If End Function
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.
