Forum Mjukvara Programmering och digitalt skapande Tråd

Regex hjälp VBA

1
Skriv svar
Permalänk
Medlem
●

Regex hjälp VBA

Jag har en sträng som ser ut typ så här: "1,6,8,32,45"
Jag vill bryta ut varje nummer åtskiljt med "," och lägga det i en array, alltså "1" "6" "8" "32" "45"
Jag behöver hjälp med hur denna funktionen och regex formeln ska se ut.
Jag behöver det till ett makro i excel så det är alltså VBA det handlar om.

Tacksam för all hjälp jag kan få.

Visa signatur

CPU: Intel i7 6700K @4,7GHz GPU: 2X GeForce GTX 980Ti SLI RAM: 32GB Corsair Vengeance LPX 2400Mhz Moderkort: Asus z170 PRO Gaming Systemdisk: Samsung 950 PRO 512GB Gamingdisk:Samsung 850 500GB Lagring: 4TB WD Red Mus: SteelSeries Rival Tangentbord: Corsair k70 Headset: Kingston HyperX Cloud http://www.it-schill.com

Redigera
Citera flera Citera
Permalänk
Medlem
●

http://www.ozgrid.com/forum/showthread.php?t=37137

Redigera
Citera flera Citera
Permalänk
Medlem ★
●

Du vill nog inte använda regex för det där. Det är en extremt ineffektiv metod om du bara vill splitta på ett enda och samma tecken. Använd split som är inbyggt i VBA.

Visa signatur

Jag är en optimist; det är aldrig så dåligt så att det inte kan bli sämre.

Redigera
Citera flera Citera
Permalänk
Medlem
●

Jag får det verkligen inte att funka.
Så här ser koden ut just nu:

Public PersonalScheduleSheet As String
Public eventSheet2 As String
Public number As Integer
Sub generateSchedule()
    
    PersonalScheduleSheet = "PersonalSchema"
    eventSheet2 = "Marknader"
    
    Dim row2 As Integer
    Dim con2 As Boolean
    
    con2 = True
    row2 = 2
    personalID = SetPersonalID
    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
     
     
    Dim Personalnr() As String
    Personalnr = Split(persons2, ",")
    
    Do While startDate2 <= endDate2
              DueDate2 = Format(startDate2, "yyyy-mm-dd")
              personalPos = Application.Match(Personalnr, personalID, False)
              asd2 = insertInfo2(DueDate2, personalPos, title2)
              startDate2 = DateAdd("d", 1, startDate2)
            Loop
            
        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) = value
        Else
            con2 = False
        End If
        number2 = number2 + 1
    Loop
    
    SetPersonalID = personalID
End Function

Function insertInfo2(eventDate2, personale2, 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, personale + 1) = title
        ElseIf value2 = "" Then
            con2 = False
        End If
        row2 = row2 + 1
    Loop
 insertInfo2 = ""
End Function

Följande kod

    Dim Personalnr() As String
    Personalnr = Split(persons2, ",")
    
    Do While startDate2 <= endDate2
              DueDate2 = Format(startDate2, "yyyy-mm-dd")
              personalPos = Application.Match(Personalnr, personalID, False)
              asd2 = insertInfo2(DueDate2, personalPos, title2)
              startDate2 = DateAdd("d", 1, startDate2)
            Loop

Spliten verkar inte fungera som den ska för
personalPos = Application.Match(Personalnr, personalID, False) alla variablerna är tomma

Jag har verkligen kört fast någon idé?

Senast redigerat
Visa signatur

CPU: Intel i7 6700K @4,7GHz GPU: 2X GeForce GTX 980Ti SLI RAM: 32GB Corsair Vengeance LPX 2400Mhz Moderkort: Asus z170 PRO Gaming Systemdisk: Samsung 950 PRO 512GB Gamingdisk:Samsung 850 500GB Lagring: 4TB WD Red Mus: SteelSeries Rival Tangentbord: Corsair k70 Headset: Kingston HyperX Cloud http://www.it-schill.com

Redigera
Citera flera Citera
Permalänk
Medlem
●

Okej nu har jag kommit en bit på vägen.
Sorteringen fungerar nästan som den ska.
Personalen sorteras in på rätt datum men det är ett litet problem bara.
Det är bara den första och den sista i Arrayen som skrivs ut.

Här kommer koden:

    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

Jag vill ju att alla ska skrivas ut inte bara den första och den sista

Visa signatur

CPU: Intel i7 6700K @4,7GHz GPU: 2X GeForce GTX 980Ti SLI RAM: 32GB Corsair Vengeance LPX 2400Mhz Moderkort: Asus z170 PRO Gaming Systemdisk: Samsung 950 PRO 512GB Gamingdisk:Samsung 850 500GB Lagring: 4TB WD Red Mus: SteelSeries Rival Tangentbord: Corsair k70 Headset: Kingston HyperX Cloud http://www.it-schill.com

Redigera
Citera flera Citera
Permalänk
Medlem
●

Jag ser ett tydligt fel nu när jag har slängt ett getöga på din kod.

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

I början av IF satsen så tilldelar du värdet för startDate2.
När du loopar igenom första personen så har du en Do While som kontrollerar att startDate2 är mindre eller lika med endDate2 för att köra ett varv till.
I loopen så plussar du på en dag för startDate2.

När du har kört klart första personen och ska börja på nästa så återställer du _INTE_ startDate2 till sitt ursprungliga värde vilket betyder att Do While loopen inte kommer köras då startDate2 är större än endDate2.

Om du tilldelar värdet till startDate2 efter "strEnPersonal = strTemp" eller använder en temp variabel så bör du få ett annat resultat.

Tips, använd debugging så kan du se vart den inte gör som förväntat.

Redigera
Citera flera Citera
Permalänk
Medlem
●

Tack så mycket jonke, än en gång löste du problemet snabbt och enkelt åt mig.
Nu har jag bara ett problem kvar.
Om det redan ligger lagrad information i en cell vill jag inte skriva över det utan helst göra en radbrytning och lägga in den nya infon.

Visa signatur

CPU: Intel i7 6700K @4,7GHz GPU: 2X GeForce GTX 980Ti SLI RAM: 32GB Corsair Vengeance LPX 2400Mhz Moderkort: Asus z170 PRO Gaming Systemdisk: Samsung 950 PRO 512GB Gamingdisk:Samsung 850 500GB Lagring: 4TB WD Red Mus: SteelSeries Rival Tangentbord: Corsair k70 Headset: Kingston HyperX Cloud http://www.it-schill.com

Redigera
Citera flera Citera
Permalänk
Medlem
●
Skrivet av Dudde:

Tack så mycket jonke, än en gång löste du problemet snabbt och enkelt åt mig.
Nu har jag bara ett problem kvar.
Om det redan ligger lagrad information i en cell vill jag inte skriva över det utan helst göra en radbrytning och lägga in den nya infon.

Gå till inlägget

Du kan köra något liknande:

Dim newValue as String
newValue = "ditt nya värde"
value2 = Sheets(PersonalScheduleSheet).Cells(1, number2 + 1).value
        
        'Kollar om det finns någon text i cellen redan, finns det text slänger den på en radbrytning (\n) och det nya värdet
        If value2 <> "" Then
          newValue = value2 + "\n" + newValue
        End If

Sheets(PersonalScheduleSheet).Cells(1, number2 + 1) = newValue
Redigera
Citera flera Citera
Permalänk
Medlem
●

Koden funkade nästan perfekt jonke.
Problemet jag har nu är att om jag kör makrot så dubbleras alla rader för varje gång jag kör makrot.
Så jag måste först tömma hela bladet sen köra makrot då blir det rätt men tömmer jag det inte så dubbleras allt.

Koden:

        If eventDate = value Then
            con = False
            
            Dim newValue As String
            newValue = title + " - " + persons + " - " + komentar
            value2 = Sheets(calendarSheet).Cells(row, responsible + 1).value
        
            If value2 <> "" Then

                newValue = value2 + vbCrLf + newValue

            End If
            Sheets(calendarSheet).Cells(row, responsible + 1) = newValue
            
        ElseIf value = "" Then
            con = False
        End If
Visa signatur

CPU: Intel i7 6700K @4,7GHz GPU: 2X GeForce GTX 980Ti SLI RAM: 32GB Corsair Vengeance LPX 2400Mhz Moderkort: Asus z170 PRO Gaming Systemdisk: Samsung 950 PRO 512GB Gamingdisk:Samsung 850 500GB Lagring: 4TB WD Red Mus: SteelSeries Rival Tangentbord: Corsair k70 Headset: Kingston HyperX Cloud http://www.it-schill.com

Redigera
Citera flera Citera
1
Skriv svar