Question

我是VBA的新手。到目前为止，我的腰带已经有4个星期了。这是用于完成报告的数据清理和分析的一长串宏的最后一部分。也许这不是最好的方法吗？我还是新手，所以我愿意接受其他建议。但它需要是一个宏观。这基本上就是它的样子（突出显示的字段用vlookup填充，这就是为什么我有两个不同的数组因为它们不连续）：

link to snip of the worksheet

行数因报告而异。有时它有4000行，有时它更多，有时它更少。但我确保每一栏都是一样的。我们正在尝试尽可能多地自动化，以便我们可以让一些技术水平较低的人能够贯穿整个过程。我第一次经历这个过程花了我6个小时（虽然我也在做笔记）。对于这里的老人来说，每个人需要大约2个小时，具体取决于。在今年年底之前，我们有大约300个这样做。

无论如何，这段代码有效，但它会覆盖我插入的所有iferror / vlookup结果。我猜我的'For Each If Then'声明应该受到指责。但是我已经在这方面工作了几天，尝试了不同的方法来实现这个目标，这是我得到的最接近的。任何帮助将不胜感激。我确信它的东西非常简单......

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
    Call OptimizeCode_Begin
        lastRow = Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
        Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)
        Set rng11 = ActiveSheet.Range("BL2:BV2" & ":BL" & lastRow)
        Set sourcerng = ActiveSheet.Range("BE2:BF2" & ":BE" & lastRow)
        arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
        arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
            For Each cell In sourcerng
                If IsEmpty(cell) Then
                    rng3.Value = arr3
                    rng11.Value = arr11
                End If
            Next
    Call OptimizeCode_End
End Sub

Answer 1

您正在引用整个范围：

rng3.Value = arr3

因此，当发现任何空白时，整个范围都会被设置，而不仅仅是那一行。我们可以使用Intersect

来完成该行

Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3

此外，您的范围错误

Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)

会引用范围BH2:BJ2:BH100

Cahnge：

Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)

这样：

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
    Call OptimizeCode_Begin
        lastRow = ActiveSheet.Range("D1").End(xlDown).Row
        Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)
        Set rng11 = ActiveSheet.Range("BL2:BV" & lastRow)
        Set sourcerng = ActiveSheet.Range("BE2:BF" & lastRow)
        arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
        arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
            For Each cell In sourcerng
                If IsEmpty(cell) Then
                    Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3
                    Intersect(rng11, ActiveSheet.Rows(cell.Row)).Value = arr11
                End If
            Next
    Call OptimizeCode_End
End Sub

Answer 2

您也可以将此版本与阵列一起使用。虽然在我的代码中结果没有粘贴到数组中，但计算是基于它们完成的，这使得代码的执行速度比在范围内的单元格上运行时要快得多。

Option Explicit
Option Base 1

Sub AutomateAllTheThings6()

Dim arr3() As String, arr11() As String
Dim rng3 As Range, rng11 As Range, sourceRng As Range
Dim vSource As Variant
Dim nCounter1 As Long, nCounter2 As Long, lastRow As Long

    Call OptimizeCode_Begin

    Const firstRow As Long = 2

    With ActiveSheet
        lastRow = .Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
        Set rng3 = .Range("BH" & firstRow & ":BJ" & lastRow)
        Set rng11 = .Range("BL" & firstRow & ":BV" & lastRow)
        Set sourceRng = .Range("BE" & firstRow & ":BF" & lastRow)
    End With

    vSource = sourceRng

    arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
    arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")

    For nCounter1 = LBound(vSource) To UBound(vSource) 'loop through all rows in source range
        For nCounter2 = LBound(vSource, 2) To UBound(vSource, 2) 'loop through all columns in the row
            If IsEmpty(vSource(nCounter1, nCounter2)) Then 'if cell is empty
                rng3.Rows(nCounter1) = arr3
                rng11.Rows(nCounter1) = arr11
                Exit For
            End If
        Next nCounter2
    Next nCounter1

   Call OptimizeCode_End

End Sub

数组范围和IsEmpty If Then语句VBA。覆盖所有内容而不是有选择地插入

2 个答案: