シートの代わりにアクティブなシート上で実行されるコード

Question

このプログラムの機能は、1つのセルのデータをコンマ区切りのエントリを新しい行に分割する行に変換することです。

まあ、私は、stackoverflowの参照質問からVBAコードを使用して、私はシート1にコードを制限するために、VBAに新しい試みたのですが、私はそれを実行するたびに、それはアクティブシート上でタスクを実行する代わりに、シート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（など）のショートカットを.Rangeにすることができるという事実を利用しないと、Withは無意味です。あなたがWith wsブロックを取り除くことができ、また

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 

し、そのシートに使用する各プロパティ/メソッド、例えばの前でwsを含める：

はにあなたのコードを変更してみてください

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