Finna tekstutdrag i kommentar i excel

[Gullars]

Hei

 

Eg har hatt lite å gjera i dag, så eg lagte like godt ein "fancy" timeplan i excel m/makro. Timeplanen fungerer slik at ein vel ein dato i kalenderen og får fram alle førelesningar, gruppearbeid, eksamenar og innleveringar for den aktuelle dagen.

 

Når det gjeld gruppearbeid, gjeld det kun for bestemte vekenummer. Desse har eg notert i kommentar-feltet for den bestemte veka. Det eg ønskjer er å gå gjennom kommentarfeltet og finna den aktuelle veka. Korleis gjer eg dette?

 

Eksempel:

 

Eg klikker på 12. september, og makroen finn at det er snakk om veke 37. Eg har funne fram til cella kor gruppearbeidet ligg. Eg vil at makroen skal søka gjennom kommentarfeltet etter "37". Viss "37" ligg der, skal eg skriva ut til dagens timeplan.

[Gjakmarrja]

Hadde vært gøy og få se source?

[Gullars]

Får alltid så mykje kritikk for dårleg programmeringsskikk, men eg ser jo at det kan hjelpa på, så her kjem det:

 

Private Sub Calendar1_Click()
      
   Dim Rekke, Kolonne, AktDato, ValgtDato, Vekedag, Fag, Skjer, Info, UtskrRekke, UtskrKolonne
   
   Kolonne = 1
   Rekke = 1
   
   UtskrKolonne = 1
   UtskrRekke = 1
   
   ValgtDato = Calendar1.Value

   Do While Worksheets("Viktige datoar").Cells(Rekke, Kolonne).Value <> ""

       AktDato = Worksheets("Viktige datoar").Cells(Rekke, Kolonne).Value
       Fag = Worksheets("Viktige datoar").Cells(Rekke, Kolonne + 1).Value
       Skjer = Worksheets("Viktige datoar").Cells(Rekke, Kolonne + 2).Value
       Info = Worksheets("Viktige datoar").Cells(Rekke, Kolonne + 3).Value
       
       If AktDato = ValgtDato Then
          If UtskrRekke = 1 Then
          
              Cells(UtskrRekke, UtskrKolonne).Value = "Fag:"
              Cells(UtskrRekke, UtskrKolonne + 1).Value = "Kva skjer?"
              Cells(UtskrRekke, UtskrKolonne + 2).Value = "Info:"
              
              UtskrRekke = UtskrRekke + 1
              
          End If
          
          Cells(UtskrRekke, UtskrKolonne).Value = Fag
          Cells(UtskrRekke, UtskrKolonne + 1).Value = Skjer
          Cells(UtskrRekke, UtskrKolonne + 2).Value = Info
          UtskrRekke = UtskrRekke + 1
          
       End If
        
       Rekke = Rekke + 1
   
   Loop
   
   Kolonne = 2
   
   Vekedag = Weekday(ValgtDato)
   
   Select Case Vekedag
       Case 2
           Kolonne = 2
       Case 3
           Kolonne = 3
       Case 4
           Kolonne = 4
       Case 5
           Kolonne = 5
       Case 6
           Kolonne = 6
   End Select
   
   For Rekke = 3 To 14
       If Worksheets("Timeplan").Cells(Rekke, Kolonne).Value <> "" Then
           If Worksheets("Timeplan").Cells(Rekke, Kolonne).Characters(1, 1).Font.Subscript = True Then
      [COLOR=red]         
       Dim Kommentar As String
       Dim VekeSok As String
       Dim VekeNr As Integer

       ' Les inndata
       Kommentar = Worksheets("Timeplan").Cells(Rekke, Kolonne).Comment.Text 'Skal henta ut kommentar frå aktuell celle. Trur ikkje han fungerer...
       VekeSok = CStr(WEEKNR(CLng(ValgtDato))) 'Vekenr som det skal søkast etter i 'Kommentar'
               
               If Kommentar = VekeSok Then 'Her må det endrast slik at "viss Kommentar inneheld VekeSok"
                   Cells(UtskrRekke, UtskrKolonne).Value = Worksheets("Timeplan").Cells(Rekke, Kolonne).Value
                   Cells(UtskrRekke, UtskrKolonne + 1).Value = "Gruppearbeid"
                   UtskrRekke = UtskrRekke + 1
               End If
[/COLOR]
           Else
               Cells(UtskrRekke, UtskrKolonne).Value = Worksheets("Timeplan").Cells(Rekke, Kolonne).Value
               Cells(UtskrRekke, UtskrKolonne + 1).Value = "Førelesning"
               UtskrRekke = UtskrRekke + 1
           End If
       End If
   Next

End Sub

Function WEEKNR(InputDate As Long) As Integer

   Dim A As Integer, B As Integer, C As Long, D As Integer
   
       WEEKNR = 0
       If InputDate < 1 Then Exit Function
       A = Weekday(InputDate, vbSunday)
       B = Year(InputDate + ((8 - A) Mod 7) - 3)
       C = DateSerial(B, 1, 1)
       D = (Weekday(C, vbSunday) + 1) Mod 7
       WEEKNR = Int((InputDate - C - 3 + D) / 7) + 1
       
End Function

[Gullars]

Prøvte å markera aktuell kode, men det er det som står mellom [ red] og [ /red] som er viktig å få med seg.

 

For å forklara litt:

 

Eg har lagt inn ein excel-kalender, som eg vel ein dato frå. Denne henter først ut eksamens- og innleveringsdatoar frå arket "Viktige datoar". Deretter skal førelesningar og gruppearbeid hentast ut frå arket "Timeplan". Gruppearbeid skiljer seg ut ved at eg har brukt subscript.

 

Problemet er rett og slett som sagt ovanfor. Korleis kan eg henta ut kommentaren? Dette fungerer ikkje:

Worksheets("Timeplan").Cells(Rekke, Kolonne).Comment.Text 

Korleis kan eg deretter søka gjennom denne tekststrengen om den har det aktuelle vekenummeret (som ligg i variabelen VekeSok)?

[aadnk]

Følgende linje, som du allerede benytter, fungerer:

 

Kommentar = Worksheets("Timeplan").Cells(Rekke, Kolonne).Comment.Text

Men du må huske å ta høyde for at den òg inkluderer forfatternavn i første linje. Derfor tror jeg det kan være lurt å fjerne den første linjen således:

' Ekstraktèr ut kommetarfelt

Kommentar = Worksheets("Sheet1").Cells(1, 1).Comment.Text

 

' Fjern den første linjen

Kommentar = Mid(Kommentar, InStr(1, Kommentar, Chr(10)) + 1)

[Gullars]

Takk! Og kva skal eg gjera for å sjekka om kommentaren inneheld VekeSok? Trur eg har gjort dette før, men gløymt det ut...

[aadnk]

Bruk InStr:

If InStr(1, Kommentar, VekeSok) <> 0 Then

[Gullars]

Tusen takk for hjelpa! Ser ut til å ha fungert fint