Meddelande

Minska
No announcement yet.

Problem med Array i VBA

Minska
X
  • Filter
  • Klockan
  • Show
Clear All
new posts

  • Problem med Array i VBA

    Min Array skriver bara ut den första och den sista posten.
    Här är koden
    Det är den fetmarkerade texten jag tror problemet ligger i
    Kod:
    Dim strPersonalCheck() As String
        
        strPersonalCheck = SetPersonalID
        con2 = True
        row2 = 2
        Do While con2 = True
            value = Sheets(eventSheet2).Cells(row2, 1).value
            If value <> "" Then
                number2 = row2
                title2 = Sheets(eventSheet2).Cells(number2, 1).value
                startDate2 = DateValue(Sheets(eventSheet2).Cells(number2, 2).value)
                endDate2 = DateValue(Sheets(eventSheet2).Cells(number2, 3).value)
                persons2 = Sheets(eventSheet2).Cells(number2, 4).value
                
                strPersonal = Trim(persons2)
                arrpersonal = Split(strPersonal, ",", -1, 1)
                For Each strTemp In arrpersonal
                strEnPersonal = strTemp
               
         
                Do While startDate2 <= endDate2
                  DueDate2 = Format(startDate2, "yyyy-mm-dd")
                  personalPos = Application.Match(strEnPersonal, strPersonalCheck, False)
                  asd2 = insertInfo2(DueDate2, personalPos, title2)
                  startDate2 = DateAdd("d", 1, startDate2)
                Loop
                 Next
            Else
                con2 = False
            End If
            
            row2 = row2 + 1
        Loop
    End Sub
     Function SetPersonalID() As String()
        Dim con2 As Boolean
        con2 = True
        
        Dim number2 As Integer
        number2 = 1
        Dim value2 As String
        Dim personalID() As String
        
        Do While con2 = True
            value2 = Sheets(PersonalScheduleSheet).Cells(1, number2 + 1).value
            
            If value2 <> "" Then
                ReDim Preserve personalID(number2) As String
             
                personalID(number2 - 1) = value2
            Else
                con2 = False
            End If
            number2 = number2 + 1
        Loop
        
        SetPersonalID = personalID
    End Function
    
    Function insertInfo2(eventDate2, personalPos, title2)
        Dim row2 As Integer
        Dim con2 As Boolean
        con2 = True
        
        row2 = 2
        
        Do While con2 = True
            
            value2 = CStr(Sheets(PersonalScheduleSheet).Cells(row2, 1).value)
            If eventDate2 = value2 Then
                con2 = False
                Sheets(PersonalScheduleSheet).Cells(row2, personalPos + 1) = title2
            ElseIf value2 = "" Then
                con2 = False
            End If
            row2 = row2 + 1
        Loop
     insertInfo2 = ""
    End Function
    Någon som ser vad jag gör för fel?
Working...
X