Question

作为较大宏的一部分，该代码应检查D列中的单元格是否以6开头。如果是这样，请复制从第2个开始的Mid 5个字符（因此，基本上跳过6个字符），以及是否并非以6开头，只需复制左侧的前5个字符并粘贴到E列中的相邻单元格中即可。

我一直都在发生溢出错误，因为文档的长度为700K行。关于如何解决此问题有什么建议吗？

Sub Left_Function()

Dim sourceRang As Range, destinationRange As Range, i As Integer, LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Set SourceRange = Sheet1.Range("D1:LastRow")
Set desinationRange = Sheet1.Range("E1:LastRow")
For i = 1 To SourceRange.Count
    For Each cell In SourceRange
        If Left(cell.Value, 1) = "6" Then
            destinationRange(i, 1).Value = Mid(SourceRange(i, 1).Value, 2, 5)
        Else: destinationRange(i, 1).Value = Left(SourceRange(i, 1).Value, 5)
        End If
    Next cell
Next i

End Sub

我不太擅长VBA，因此基于我搜索过的内容，这是相当不错的修补工作，因此，如果您有其他代码，那么我就会不知所措。

Answer 1

您的代码中有很多问题

数据类型使用不正确（整数而不是Long）
无效的范围定义Range("D1:LastRow")
变量名和对象引用中的许多错字
不一致的Worksheet引用（ActiveSheet可能是Sheet1也可能不是）
不必要的嵌套For循环（这会耗尽您的运行时间）
对于如此大的数据集，直接循环范围将使代码非常慢

解决了这些问题，并转换为Variant Array方法：

Option Explicit

Sub Left_Function()
    Dim ws As Worksheet
    Dim sourceRange As Range, destinationRange As Range
    Dim i As Long
    Dim src As Variant, dst As Variant

    Set ws = ActiveSheet
    With ws
        Set sourceRange = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
        Set destinationRange = sourceRange.Offset(0, 1)
        src = sourceRange.Value
        ReDim dst(1 To UBound(src, 1), 1 To 1)

        For i = 1 To UBound(src, 1)
            dst(i, 1) = Mid$(src(i, 1), IIf(Left$(src(i, 1), 1) = "6", 2, 1), 5)
        Next

        destinationRange = dst
    End With
End Sub

Answer 2

我认为您溢出的原因是您将i和LastRow指定为Int类型。 Int的最大值为32767，因此，如果您有700K行，则会发生溢出。要解决此问题，请将类型更改为Long。

另外，由于某些原因，您初始化SourceRange和destinationRange的方式也似乎是错误的--- "D1:LastRow"之类的表达式只是字符串文字，不会给出有效范围在Excel中。

您需要这样的东西：

Sheet1.Range("D1:D" & CStr(LastRow))

这里有3处细微的变化。首先，CStr(LastRow)将数字LastRow转换为其等效的字符串。其次，&连接字符串（您也可以使用+）。第三，请注意需要明确为范围的开始和结束指定列：D1：100无效（仅一个D）；但D1：D100可以使用。

希望有帮助。

如何解决700K行范围上的溢出

2 个答案: