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

Question

早上好！

我目前正在编写具有 VBA 支持函数的 Excel 表单。这些功能将允许用户 1. 将新的输入行添加到 spreadsheet，2. 将数据的 sheet 和 return 擦除到其原始配置，以及 3. 复制sheet中的数据到一个数据累加sheet.

到目前为止，我已经完成了第 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

让我们稍微缩短一下：（这允许用户 select 多个按钮条件）

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

Use VBA on new rows and not on existing rows

excel

vba