1

行のいくつかの列をループして、現在の列/行の値の名前で新しいワークシートを作成しようとしています。

Sub test()
    Range("R5").Select
    Do Until IsEmpty(ActiveCell)
        Sheets.Add.Name = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

このコードは、 R5から正しく最初のコードを作成しますが、マクロがそのワークシートに切り替わり、タスクを完了していないように見えます。

4

4 に答える 4

4

Sheets.Addは、選択範囲を新しく作成されたシートに自動的に移動します（新しいシートを手動で挿入する場合と同じです）。結果として、オフセットは新しいシートのセルA1に基づいており、これが選択になりました。空のセルを選択すると（シートが空であるため）、ループが終了します。

Sub test()
Dim MyNames As Range, MyNewSheet As Range

    Set MyNames = Range("R5").CurrentRegion ' load contigeous range into variable
    For Each MyNewSheet In MyNames.Cells    ' loop through cell children of range variable
        Sheets.Add.Name = MyNewSheet.Value
    Next MyNewSheet
    MyNames.Worksheet.Select                ' move selection to original sheet
End Sub

これはうまく機能します....名前のリストをRange型のオブジェクト変数に割り当て、ForEachループでこれを処理します。終了したら、選択範囲を元の場所に戻します。

于 2012-08-22T19:36:54.013 に答える
1

Sheets.Add新しいシートが自動的にアクティブシートになります。最善の策は、オブジェクトに変数を宣言し（これは常にベストプラクティスです）、それらを参照することです。私が以下で行ったように見てください：

 Sub test()

    Dim wks As Worksheet
    Set wks = Sheets("sheet1")

    With wks

       Dim rng As Range
       Set rng = .Range("R5")

       Do Until IsEmpty(rng)
            Sheets.Add.Name = rng.Value
            Set rng = rng.Offset(0, 1)
       Loop

   End With

End Sub
于 2012-08-22T19:37:18.633 に答える
1

処理するリストからシートに名前を付けるときは、常にエラー処理を使用する必要があります

  • シート名に無効な文字が含まれています
  • 長すぎるシート名
  • 重複するシート名

Sheets("Title")タイトルシートのシート名（または位置）に合わせてplsが変更されます

以下のコードは、パフォーマンス上の理由から、シート名の範囲ではなくバリアント配列を使用していますが、オフScreenUpdatingにするとユーザーに最大の違いが生じる可能性があります

Sub SheetAdd()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strError As String
Dim vArr()
Dim lngCnt As Long
Dim lngCalc As Long

Set ws1 = Sheets("Title")
vArr = ws1.Range(ws1.[r5], ws1.[r5].End(xltoRight))

If UBound(vArr) = Rows.Count - 5 Then
MsgBox "sheet range for titles appears to be empty"
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
End With

For lngCnt = 1 To UBound(vArr)
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = vArr(lngCnt, 1)
If Err.Number <> 0 Then strError = strError & vArr(lngCnt, 1) & vbNewLine
On Error GoTo 0
Next lngCnt


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
End With

If Len(strError) > 0 Then MsgBox strError, vbCritical, "These potential sheet names were invalid"

End Sub
于 2012-08-23T00:04:07.577 に答える
0

これはおそらく最も簡単です。エラー処理は不要で、シートを作成するための1回限りのコード

Sub test()
Workbooks("Book1").Sheets("Sheet1").Range("A1").Activate
Do Until IsEmpty(ActiveCell)
    Sheets.Add.Name = ActiveCell.Value
    Workbooks("Book1").Sheets("Sheet1").Select
    ActiveCell.Offset(0, 1).Select
Loop
End Sub
于 2013-08-22T15:08:24.330 に答える