vba - 在任何事件工作表而不是工作表 1 上运行的代码

Question

该程序的功能是将一个单元格的数据转换为行，即将逗号分隔的条目拆分为新行。

嗯，我是 VBA 新手，使用 stackoverflow 引用问题中的 vba 代码，我尝试将代码限制为 sheet1 但每当我运行它时，它都会执行事件工作表而不是工作表 1 上的任务。

Sub SliceNDice()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr

Set ws = ThisWorkbook.Sheets("Sheet1")

With ws
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
 'Define the range to be analysed

X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
ReDim Y(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
     'Split each string by ","
    tempArr = Split(X(lngRow, 2), ",")
    For Each strArr In tempArr
        lngCnt = lngCnt + 1
         'Add another 1000 records to resorted array every 1000 records
        If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 2, 1 To lngCnt + 1000)
        Y(1, lngCnt) = X(lngRow, 1)
        Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
    Next
Next lngRow
 'Dump the re-ordered range to columns C:D

[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
End With
End Sub

在这方面需要提供建议。

Answer 1

正如评论中提到的，如果您不利用它允许您将 ws.Range (等)快捷方式设置为仅的事实，那么您的 With 是毫无意义的.范围.

尝试将代码更改为:

Sub SliceNDice()
    Dim objRegex As Object
    Dim X
    Dim Y
    Dim lngRow As Long
    Dim lngCnt As Long
    Dim tempArr() As String
    Dim strArr

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        Set objRegex = CreateObject("vbscript.regexp")
        objRegex.Pattern = "^\s+(.+?)$"
        'Define the range to be analysed

        '"." is needed to qualify which sheet Range, Cells, and Rows applies to.
        'Without a "." (or a "ws."), each property would refer to the active sheet.
        X = .Range("A1", .Cells(.Rows.Count, "b").End(xlUp)).Value2
        ReDim Y(1 To 2, 1 To 1000)
        For lngRow = 1 To UBound(X, 1)
            'Split each string by ","
            tempArr = Split(X(lngRow, 2), ",")
            For Each strArr In tempArr
                lngCnt = lngCnt + 1
                'Add another 1000 records to resorted array every 1000 records
                If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 2, 1 To lngCnt + 1000)
                Y(1, lngCnt) = X(lngRow, 1)
                Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
            Next
        Next lngRow
        'Dump the re-ordered range to columns C:D

        'Only write output if there is something to write
        If lngCnt > 0 Then
            'Need to also specify that the following line applies to ws, rather
            'than to the active sheet
            .Range("C1").Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
        End If
    End With
End Sub

或者，您可以去掉 With ws block ，并在该工作表上使用的每个属性/方法前面包含 ws，例如

X = ws.Range("A1", ws.Cells(ws.Rows.Count, "b").End(xlUp)).Value2