excel 在每次迭代中将单元格归零后，无法使用集合保存和还原数据

wnavrhmk 于 2023-10-22 发布在其他

关注(0)|答案(1)|浏览(111)

该复选框应将目标单元格中的数据重置为零，如果未选中，则将其返回。我想在集合中存储迭代之间的数据，但是这不起作用，所有值都为零。
有没有办法在迭代期间将这些值存储在单元格中？请帮帮我也忽略颜色，最重要的是让归零和返回单元格数据工作。

Private Sub CheckBox1_Click()
    Dim ws As Worksheet
    Dim cell As Range
    Dim targetValue As String

    Dim originalValue As Variant
    Dim originalDataCollection As New Collection
    
    targetValue = "СОК"
    Set ws = ThisWorkbook.Sheets("Лист1") ' Replace with your sheet name
    
    Set originalDataCollection = New Collection
    
    If CheckBox1.Value = True Then
        ' When the checkbox is checked, change the text and background color of matching cells to white
        For Each cell In ws.Range("A1:AE61")
            If cell.Value = targetValue Then
                originalColor = cell.Offset(0, -1).Font.Color
                originalInteriorColor = cell.Offset(0, -1).Interior.Color
                cell.Offset(0, -1).Font.Color = RGB(255, 255, 255) ' Change the text color to white
                cell.Offset(0, -1).Interior.Color = RGB(255, 255, 255) ' Change the background color to white
                cell.Offset(0, -2).Font.Color = RGB(255, 255, 255) ' Change the text color to white
                cell.Offset(0, -2).Interior.Color = RGB(255, 255, 255) ' Change the background color to white
                cell.Offset(0, -3).Font.Color = RGB(255, 255, 255) ' Change the text color to white
                cell.Offset(0, -3).Interior.Color = RGB(255, 255, 255) ' Change the background color to white
                cell.Offset(0, 0).Font.Color = RGB(255, 255, 255) ' Change the text color of the cell on the left to white
                cell.Offset(0, 0).Interior.Color = RGB(255, 255, 255) ' Change the background color to white
                
                ' Store the original value of cell.Offset(0, -2)
                originalValue = cell.Offset(0, -2).Value
                originalDataCollection.Add originalValue
                
                ' Set the value of cell.Offset(0, -2) to zero
                cell.Offset(0, -2).Value = 0
            End If
        Next cell
    Else
        ' When the checkbox is unchecked, reset the text and background color to the original for matching cells
        For Each cell In ws.Range("A1:AE61")
            If cell.Value = targetValue Then
                cell.Offset(0, -1).Font.Color = originalColor
                cell.Offset(0, -1).Interior.Color = RGB(255, 0, 0) ' Reset background color to original
                cell.Offset(0, -2).Font.Color = originalColor
                cell.Offset(0, -2).Interior.Color = RGB(255, 0, 0) ' Reset background color to original
                cell.Offset(0, -3).Font.Color = originalColor
                cell.Offset(0, -3).Interior.Color = RGB(255, 0, 0) ' Reset background color to original
                cell.Offset(0, 0).Font.Color = originalColor
                cell.Offset(0, 0).Interior.Color = RGB(152, 212, 84)
                
                 If originalDataCollection.Count > 0 Then
                    cell.Offset(0, -2).Value = originalDataCollection(1)
                    originalDataCollection.Remove 1 ' Remove the first item from the collection
                End If
            End If
        Next cell
    End If
End Sub

excel

来源：https://stackoverflow.com/questions/77296253/cannot-save-and-revert-data-using-collections-after-zeroing-cells-in-each-iterat

1条答案

按热度按时间

klr1opcd1#

Declare Sub外部的变量，以便在Sub退出时保留值。

Option Explicit

Dim arData(1 To 61, 1 To 31) 'A1:AE61
Dim arFont(1 To 61, 1 To 31) 'A1:AE61
Dim arInterior(1 To 61, 1 To 31) 'A1:AE61

Private Sub CheckBox1_Click()
    Dim ws As Worksheet, cell As Range
    Dim r As Long, c As Long, i As Long
    Dim targetValue As String

    targetValue = "СОК"
    Set ws = ThisWorkbook.Sheets("Лист1") ' Replace with your sheet name
    
    If CheckBox1.Value = True Then
        ' When the checkbox is checked
        ' change the text and background color of matching cells to white
        For Each cell In ws.Range("A1:AE61")
        
            ' Store the original value
            r = cell.Row
            c = cell.Column
            arData(r, c) = cell.Value2
            arFont(r, c) = cell.Font.Color
            arInterior(r, c) = cell.Interior.Color
        
            If cell.Value = targetValue Then
                With cell.Offset(0, -3).Resize(, 4)
                   .Font.Color = RGB(255, 255, 255) ' Change the text color to white
                   .Interior.Color = RGB(255, 255, 255) ' Change the background color to white
                End With
                
                ' Set the value of cell.Offset(0, -2) to zero
                cell.Offset(0, -2).Value = 0
            End If
        Next cell
        MsgBox "Saved"
    Else
        ' When the checkbox is unchecked
        'reset the text and background color to the original for matching cells
        For Each cell In ws.Range("A1:AE61")
            r = cell.Row
            c = cell.Column
            If cell.Value = targetValue Then
                For i = -3 To 0
                    cell.Offset(0, i).Font.Color = arFont(r, c - i)
                    If i = 0 Then
                        cell.Interior.Color = RGB(152, 212, 84)
                    Else
                        cell.Offset(0, i).Interior.Color = arInterior(r, c - i)
                    End If
                    
                    If i = -2 Then
                        cell.Offset(, -2) = arData(r, c - 2)
                    End If
                Next
            End If
        Next cell
        MsgBox "Restored"
    End If
End Sub

赞(0）回复(0）举报 2023-10-22

我来回答

excel 在每次迭代中将单元格归零后，无法使用集合保存和还原数据

1条答案

相关问题

热门标签

最新问答