Question

早上好！

我目前正在编写一个带有VBA支持功能的Excel表单。这些功能将允许用户1.向电子表格添加新的输入行，2。擦除数据表并将其返回到其原始配置，然后3.将工作表中的数据复制到数据累积表。

到目前为止，我已完成第2点并且正在进行1.我在循环中遇到了问题。问题是这个循环不断地重复它自己（这是循环点......）在它不必要的单元格上反复出现。我有一种潜在的怀疑，就是它在循环的迭代计数器中，我应该做一个改变，以便它不会总是在开始时再次开始，但我迷失了如何做到这一点。循环的功能是根据用户选择的选项框将值1赋予适当的单元格。实际上，代码重写整个列而不是它应该在的行。因此，数据在以前填充的单元格中丢失。

代码如下：

Private Sub NextLineRed()

Dim i As Long
Dim End Row As Long

EndRow = ThisWorkbook.Worksheets.("Drapeaux Rouges").Cells(Rows.Count.1).End(xlUp).Row

    For i = 19 To EndRow + 1 Step 1
        If MétalButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7) = 1
        End If

        If TMétalButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8) = 1
        End If

        If ContaButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9) = 1
        End If

        If MottonButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10) = 1
        End If

        If TrouButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11) = 1
        End If

        If TombéButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12) = 1
        End If

        If AutreButton.Value = True Then
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 7).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 8).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 9).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 10).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 11).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 12).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13).ClearContents
            ThisWorkbook.Worksheets("Drapeaux Rouges").Cells(i, 13) = 1
        End If
    Next

End Sub

Answer 1

让我们稍微缩短一点:(这允许用户选择MULTIPLE Button条件）

Private Sub NextLineRed()

Dim i As Long
Dim EndRow As Long
Dim ws1 As Worksheet

Set ws1 = ThisWorkbook.Worksheets("Drapeaux Rouges")
EndRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    ws1.Range(Cells(EndRow, 7), Cells(EndRow, 13)).ClearContents
            If MétalButton.Value = True Then ws1.Cells(EndRow, 7) = 1
            If TMétalButton.Value = True Then ws1.Cells(EndRow, 8) = 1
            If ContaButton.Value = True Then ws1.Cells(EndRow, 9) = 1
            If MottonButton.Value = True Then ws1.Cells(EndRow, 10) = 1
            If TrouButton.Value = True Then ws1.Cells(EndRow, 11) = 1
            If TombéButton.Value = True Then ws1.Cells(EndRow, 12) = 1
            If AutreButton.Value = True Then ws1.Cells(EndRow, 13) = 1

End Sub

在新行上使用VBA而不在现有行上使用VBA

1 个答案: