Problem med VBA i Excel

Det här svaret har översatts automatiskt. Det kan därför finnas grammatiska fel eller konstiga formuleringar.

Bäste Anders Hallfors,

Välkommen till Microsoft-communityn.

Efter att ha följt din beskrivning testade jag följande kod som du kan hänvisa till:

Sub ChangeRowcontent()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("YourSheetName")

    On Error GoTo ErrHandler

    ' Check checkbox D1

    If ws.Range("D1").Value = True Then

        ws.Rows("3:3").Insert Shift:=xlDown

        ws.Cells(3, 1).Value = "Length:"

    ElseIf ws.Range("D1").Value = False Then

        ' Check for line 3 before deleting it

        If ws.Rows.Count >= 3 Then

            ws.Rows("3:3").Delete Shift:=xlUp

        End If

    End If

    ' Check checkbox F1

    If ws.Range("F1").Value = True Then

        ' Add new lines and text

        ws.Rows(4).Insert Shift:=xlDown

        ws.Rows(6).Insert Shift:=xlDown

        ws.Cells(4, "AB").Value = "Break to Ridge:"

        ws.Cells(6, "AB").Value = "Sqm 1 side:"

        ws.Cells(3, "AB").Value = "Foot to Break:"

    ElseIf ws.Range("F1").Value = False Then

        ' Remove the extra lines

        If ws.Rows.Count >= 6 Then

            ws.Rows(6).Delete Shift:=xlUp

            ws.Rows(4).Delete Shift:=xlUp

        End If

        ws.Cells(3, "AB").Value = "Foot to ridge:"

    End If

    Exit Sub

ErrHandler:

    MsgBox "An error occurred: " & Err.Description

End Sub

Logik för infogning och borttagning av fast rad: Säkerställde att rader infogas och tas bort korrekt.

Uppdaterade cellvärden: Fixade logiken för att uppdatera värdena för cellerna AB3, AB4 och AB6.

Säkerhetskopiering: Säkerhetskopiera alltid dina Excel-filer innan du kör skript som ändrar strukturer eller data.

Men eftersom mitt modersmål inte är språket i ditt land kan jag ha några missförstånd om din beskrivning, om det passar dig kan du dela din fil med oss i ett privat meddelande så hjälper vi dig att göra ytterligare tester och implementering.

Du kan dela den här:

Tveka inte att kontakta oss när som helst om du har några frågor.

Tack för din förståelse och ditt tålamod.

Varma hälsningar Isabella-MSFT | Microsoft Community Support Specialist

Allmänt:

ws.Rows.Count

ger det totala antalet rader i bladet. Så:

lastRow = ws.Rows.Count

Borde bli en dryg miljon rader

Test att stega med F8. eller lägg in en

msgbox ws.Rows.Count

så dina kontroller, exempelvis koden:

        ' Kontrollera om rad 3 finns innan du tar bort den If ws.Rows.Count >= 3 Then Kommer alltid att bli sant eftersom radräkningen alltid är en miljon-ish.

För att återgå till ditt problem så tror jag att ett bidragande bekymmer är att koden för både D1 och F1 jämt körs

Dvs om du kryssar i D1 men inte F1 så kommer den att peta in rad3. Sen ser den att F1 inte är ikryssat och eftersom dina rad-villkor alltid är uppfyllda så tar den bort raderna 4 och 6.

Samma sak om D1 är tom men F1 är ifyllt osv. Du måste nog lägga in en massa kontroller för at lista ut hur bladet ser ut innan du stökar runt.

Exempel där jag undviker nästlade villkor. Men även här kommer det att bli konstigt om du kryssar i och ur båda rutorna.

Jag skulle nästan fundera på att lägga två separata makron som triggas av respektive kryssruta.

Sub ÄndraRadinnehåll()
   Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    On Error GoTo ErrHandler

    ' Kontrollera kryssruta D1 och om cell A3 inte är ändrad redan
    If (ws.Range("D1").Value = True And ws.Range("A3").Value <> "Längd:") Then
        ws.Rows(3).EntireRow.Insert Shift:=xlDown
        ws.Range("A3").Value = "Längd:"
    End If

    If (ws.Range("D1").Value = False And ws.Range("A3").Value = "Längd:") Then
            ws.Rows(3).Delete Shift:=xlUp
    End If

' Kontrollera om kryssruta F1 är true och AB3 inte är ändrat till "Fot till Bryt:" redan
' Det får representera hela paketet
    If (ws.Range("F1").Value = True And ws.Cells(3, "AB").Value <> "Fot till Bryt:") Then
        ' Lägg till nya rader och text
        ws.Rows(6).Insert Shift:=xlDown
        ws.Rows(4).Insert Shift:=xlDown
        ws.Range("AB6").Value = "Kvm 1sida:"
        ws.Range("AB4").Value = "Bryt till nock:"
        ws.Range("AB3").Value = "Fot till Bryt:"
    End If

    If ws.Range("F1").Value = False Then
        ' Ta bort de extra raderna om det finns ett värde i AB
        If ws.Cells(6, "AB").Value = "Kvm 1sida:" Then
            ws.Rows(6).Delete Shift:=xlUp
        End If
        If ws.Cells(4, "AB").Value = "Bryt till nock:" Then
            ws.Rows(4).Delete Shift:=xlUp
        End If
        If ws.Cells(3, "AB").Value = "Fot till Bryt:" Then
            ' Tömmer cell AB3
            ws.Range("AB3").Value = ""
        End If
    End If

Exit Sub

ErrHandler:
    MsgBox "Ett fel uppstod: " & Err.Description
End Sub