【问题标题】:How to check for equal values in cells with a for loop?如何使用 for 循环检查单元格中的相等值?
【发布时间】:2020-02-19 11:14:45
【问题描述】:

我想用 for 循环检查单元格中的文本值是否与下面单元格中的相同。

如果 Cell(1) 和 Cell(2) 中的值不匹配,我希望将 Cell(3) 中的值写入 Cell(4)。

我收到一个错误

“溢出(错误 6)”

Dim i As Integer

For i = 1 To Rows.Count

    If Cells(2 + i,21) = Cells(3 + i,21) Then
        i = i + 1
    Else
        a = Cells(3 + i, 1)
        j = j + 1
        Cells(228 + j, 3) = a
    End If

Next i

End Sub

我有一个生产输出和一个从早上 6 点到 12 点的时间表,我想创建一个时间表,如下所示。

截图:

【问题讨论】:

  • 您的a 变量未声明:Dim a as Range,也未设置:Set a = Cells(3+i,1)。还将i 声明为Long,而不是Integer
  • 首先,将For i = 1 to Rows.Count 替换为more reliable lastrow statement
  • 不要使用Integer变量(很容易导致溢出),改用Long。根据@Plution,还请使用更可靠的方法来检索最后一行。此外,我建议至少使用工作表引用并循环遍历数组(通过内存)而不是单元格。话虽如此。请您提供一些模型示例数据和预期结果吗?
  • @Teamothy,我不认为a 变量是一个范围对象。相反,我认为 OP 正在尝试写 Cells(228 + j, 3) = Cells(3 + i, 1)
  • @JvdV 是的,我的错,他想要一个值而不是范围,采用你的方法会更容易。

标签: excel vba for-loop comparison


【解决方案1】:

你可以使用

Option Explicit

Sub test()

    Dim LastRowA As Long, i As Long, j As Long, LastRowW As Long
    Dim StartTime As Date, EndTime As Date, strOutPut

    j = 0

    With ThisWorkbook.Worksheets("Sheet1")

        LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 3 To LastRowA

            If i > j - 1 Then

                StartTime = .Range("A" & i).Value
                strOutPut = .Range("U" & i).Value

                For j = i + 1 To LastRowA + 1

                    If strOutPut <> .Range("U" & j).Value Then

                        EndTime = .Range("A" & j - 1).Value
                        LastRow = .Cells(.Rows.Count, "W").End(xlUp).Row

                        .Range("W" & LastRow + 1).Value = StartTime
                        .Range("X" & LastRow + 1).Value = EndTime
                        .Range("Y" & LastRow + 1).Value = strOutPut

                        Exit For

                    End If

                Next j

            End If

        Next i

    End With

End Sub

结果

【讨论】:

    【解决方案2】:

    这里我使用了一个字典,它将存储每个产品逗号分隔的每次时间,因此稍后将对其进行拆分并取第一次和最后一次出现:

    Sub TimeTable()
    
            'Declare an array variable to store the data
            'change MySheet for your sheet name
            arr = ThisWorkbook.Sheets("MySheet").UsedRange.Value 'this will store the whole worksheet, the used area.
    
            'Declare a dictionary object
            Dim Products As Object: Set Products = CreateObject("Scripting.Dictionary")
    
            'Loop through the array
            Dim i As Long
            For i = 3 To UBound(arr) 'start from row 3 because of your screenshoot
                If arr(i, 21) = vbNullString Then GoTo NextRow 'if column U is empty won't add anything
                If Not Products.Exists(arr(i, 21)) Then '21 is the column index for column U
                    Products.Add arr(i, 21), arr(i, 1)
                Else
                    Products(arr(i, 21)) = arr(i, 21) & "," & arr(i, 1)
                End If
    NextRow:
            Next i
            Erase arr
    
            'Redim the array to fit your final data, 4 columns and as many rows as products
            ReDim arr(1 To Products.Count + 1, 1 To 4)
    
            'Insert the headers
            arr(1, 1) = "Time"
            arr(1, 4) = "Product / Error"
    
            'Now loop through the dictionary
            Dim Key As Variant, MySplit As Variant
            i = 2
            For Each Key In Products.Keys
                MySplit = Split(Products(Key), ",")
                arr(i, 1) = MySplit(LBound(MySplit))
                arr(i, 2) = "-"
                arr(i, 3) = MySplit(UBound(MySplit))
                arr(i, 4) = Key
                i = i + 1
            Next Key
    
    
            'I don't know where are you going to paste your data, so I'm making a new worksheet at the end of your workbook
            Dim ws As Worksheet
            Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            With ws
                .Range("A1").Resize(UBound(arr), UBound(arr, 2)).Value = arr
                .Range("A1:C1").Merge
            End With
    
    End Sub
    

    【讨论】:

      猜你喜欢
      • 2015-10-23
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2023-03-16
      • 1970-01-01
      • 1970-01-01
      • 2013-03-27
      • 1970-01-01
      相关资源
      最近更新 更多