ママのスキンケアのお悩みにおすすめアイテム

・先日VBAでシートのコピー時にシート名の変更の仕方をしえて頂き完成したのですが、ある問題が発生し困っています。以下が状況です。
シート1、シート2が有りシート1のコピーボタンを押すとシート1の例えば「A1」セル(2006-01)を参照しシート2の後に「2006-1」のシートを作成迄は教えて頂き出来ました。しかしシート1の「A1」セル(2006-01)を更新するのを忘れてコピーボタンを押すとエラーになってしまいます。同じシート名がある時は「重複です。」とかメッセージを出して中止したいのですが初心者で旨くいきません。nov-dさんの回答を元に色々調べましたが旨く動きません。ご教授宜しくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

処理前に重複シート名をチェックする方法です。



Private Sub CommandButton1_Click()

Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value

'シート名チェック
Dim ws As Variant
Dim flg As Boolean
For Each ws In ThisWorkbook.Worksheets
If Sheet_Name = ws.Name Then
flg = True
Exit For
End If
Next

If flg = False Then

Worksheets(1).Copy After:=Worksheets(2)

Sheets(2).Activate
Range("B36:B67").Select
Selection.ClearContents


Sheets(1).Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select

'Unload UserForm2

ActiveSheet.Name = Sheet_Name

Else
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

End If

End Sub

この回答への補足

・回答ありがとうございます。早速試してみて旨く動くのでシート名1を「稼動」、シート名2を「祝日」と変更し実行すると「稼動」シートのA1を参照し「稼動」シート名が「XXX」と変更され、「祝日」シートの後にコピーされたシート名は「稼動(2)」となってしまいます。以下がプログラムです。どこが違うか分かりません。ご教授宜しくお願いいたします。

Private Sub CommandButton1_Click()

Dim Sheet_Name As String
Sheet_Name = Worksheets("稼動").Range("A1").Value

'シート名チェック
Dim ws As Variant
Dim flg As Boolean
For Each ws In ThisWorkbook.Worksheets
If Sheet_Name = ws.Name Then
flg = True
Exit For
End If
Next

If flg = False Then

Worksheets("稼動").Copy After:=Worksheets("祝日")

Sheets("祝日").Activate
Range("B36:B67").Select
Selection.ClearContents


Sheets("稼動").Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select
'Unload UserForm2

ActiveSheet.Name = Sheet_Name


Else
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

'MsgBox " D:15のスピンボタンをクリックし、月度を変更して下さい。次にI:6とJ:6に月度の開始日と終了日を記入して下さい!!"

End If

End Sub

補足日時:2006/01/15 20:47
    • good
    • 0
この回答へのお礼

・hana-hana3有難うございました。
補足を記入後冷静に見てみると
ActiveSheet.Name = Sheet_Nameがsheet1がActivate
なってから実行なので当たり前でした。シートコピー後すぐActiveSheet.Name = Sheet_Name実行で見事解決いたしました。本当に有難うございました。

お礼日時:2006/01/15 21:20

nov-dです。

プログラム、読ませていただきました。

自分の書いたプログラムのポイントは、「Worksheets(1).Copy After:=Worksheets(2)」の後すぐに「ActiveSheet.Name = Sheet_Name」としている点です。
(すぐと言っても、エラー判定のため「On Error GoTo ERR1」を間にはさんでいますが。)

WorkSheets(1).Copy・・・を実行すると、コピー後のシート(この時点では「Sheet1(1)」)がActiveになります。
そこで、Activeになっているシートを(「XXX」に)リネームするという仕組みです。

いただいたプログラムでは、その間に(「Sheets(1).Activate」などで)Activeなシートが変わってしまっているため、うまく動かないということだと思います。
試しに、「WorkSheets(1).Copy・・・」の行を、「On Error GoTo ERR1」の1行手前に移動してみてもらえませんか?
多分うまく動くと思うのですが。。。f^_^;
うまく動かなければ、またここで書いていただければと思います。

PS.
こちらではユーザーフォームを作らずに実行しているため、「Unload UserForm2」の行はコメントアウトして(行頭に「'」を付けて)実行しています。

この回答への補足

・回答ありがとうございました。Copy行を変更すると旨く動きましたが、何故か私のプログラムではシート名の重複がある時ちゃんとエラーは出るのですが「シート1(2)」が出来てしまいます。又、データを消してからコピーするのでこれでは本題から逸脱します。元のままだとシート1が「XXX」と名前変更され、シート2の後に「シート1(2)」が出来てしまいます。モーちょっと頑張って見ます。又ご教授お願いします。

補足日時:2006/01/15 21:00
    • good
    • 0
この回答へのお礼

・nov-dさんありがとうございました。おっしゃるとおり、「WorkSheets(1).Copy・・・」を動かして冷静に書き直して旨く動くようになりました。本当にありがとうございました。

お礼日時:2006/01/15 21:17

nov-dです。


あれ、上手くいきませんでしたか?
こっちでやると、(シートのコピー時ではなく)シート名のリネーム時にエラーハンドラが働いて、上手くerr1に飛びますが。。。
良ければプログラムを見せてもらえませんか?

Sub Copy_Sheet()
Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value
Worksheets(1).Copy After:=Worksheets(2)
On Error GoTo ERR1
ActiveSheet.Name = Sheet_Name
Exit Sub
ERR1:
MsgBox ("シート名が重複しています。別のシート名を指定してください。")
Exit Sub
End Sub

この回答への補足

・早速の回答ありがとうございます。実際の自分のプログラムの流れは以下の様にシート1,2の値を消すようにして有ります。流れを全て書くと

1)シート1の「A1」の値(XXX)を参照しシート2の後にシート1の名前を「XXX」にしてコピーする。
2)その際「XXX」が有れば処理を中止する。
3)「XXX」がなければシート1,2の値をクリヤーする
以上です。
因みに以下がプログラムです。

Private Sub CommandButton1_Click()
Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value
Worksheets(1).Copy After:=Worksheets(2)

Sheets(2).Activate
Range("B36:B67").Select
Selection.ClearContents


Sheets(1).Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select

Unload UserForm2

On Error GoTo ERR1
ActiveSheet.Name = Sheet_Name
Exit Sub
ERR1:
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

Exit Sub

End Sub

よろしくお願いします。

補足日時:2006/01/15 18:51
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルのシート名変更で重複した時のvbaの処理

こんにちは。vba初心者です。

セルのA1を参照してシート名を変更するとき
名前が重複したら、A1に入力されている文字列の後に(2)とつけたいのですが、
その重複したときの処理ができません。

シート名を変更するところまではできました。
以下のvbaです。

Sub test()
Dim aSheet As Worksheet
For Each aSheet In Worksheets
aSheet.Select
aSheet.Name = Range("A1")
On Error Resume Next
Next aSheet
End Sub

これに付け加えるか全然違ってもかまいません。
何かよい方法を教えてください。
説明が不十分かもしれませんが、よろしくお願いします。

Aベストアンサー

capybaruさん

シート名が重複したら、(2),(3)…と番号を増やすようにしました。
また、capybaruさんのプログラムをベースにしています。
  
Sub test()
 Dim aSheet As Worksheet
 Dim NO   As Integer
 For Each aSheet In Worksheets
  aSheet.Select
  NO = 1
  On Error Resume Next
  Do
   Err.Clear
   aSheet.Name = Range("A1") & IIf(NO = 1, "", Format(NO, "(#)"))
   If Err.Number = 0 Then Exit Do
   NO = NO + 1
  Loop
  On Error GoTo 0
 Next aSheet
End Sub

QVBAでシートコピー後、シート名が重複している時の処理

今日からVBAを勉強し始めました初心者です。会社である作業をしており、VBAでの作業がうまくいかなくて困っております。

「実績」というシートを11/5に作ったとします。
このシートを、11/9にマクロを実行した時に、
  ・11/5のシートをコピーし複製を作る(この時点ではシート名は「実績(2)」)
  ・この時、シート名は「11-05」となるように設定済み
   (実績シートの「G1」セルから、日付を取得しファイル名とする) としています。

この時、まれに同じ日に間違ってマクロを動かす為、同じシート名となりエラーが出てしまいます。
利用者が不慣れなため、エラーの対処方法を教えることでは対処が難しい状態で、できればマクロで対応しようと思っています。

以下、シート名が重複しない場合のみ利用可能なデータです。

'前回作成した「実績」のコピー&リネーム

Dim mySheet As Worksheet
Set mySheet = ActiveWorkbook.Worksheets("実績")
mySheet.Copy after:=Worksheets("実績")
  '実績sheetの後ろにコピー
ActiveSheet.Name = Format(Range("G1").Value, "m-dd")
' シート名を変更する

他の質問を検索しましたが、コピーしたファイルをリネームし、
そのリネーム結果が重複している場合の記述方法がよくかわりませんでした。

重複している場合は、できればメッセージボックスで「yesno」の選択で上書きの選択ができればと思っています。
(VBAでは一度削除してから新規に作るようですが、上の重複のからみで、よくわからなくなっています)

よろしくお願いします。

今日からVBAを勉強し始めました初心者です。会社である作業をしており、VBAでの作業がうまくいかなくて困っております。

「実績」というシートを11/5に作ったとします。
このシートを、11/9にマクロを実行した時に、
  ・11/5のシートをコピーし複製を作る(この時点ではシート名は「実績(2)」)
  ・この時、シート名は「11-05」となるように設定済み
   (実績シートの「G1」セルから、日付を取得しファイル名とする) としています。

この時、まれに同じ日に間違ってマクロを動かす...続きを読む

Aベストアンサー

こんばんは。

>ActiveSheet.Name = Format(Range("G1").Value, "m-dd")

意味は分かるのですが、こういうコードは、確かにこれで通るのですが、かなり乱暴なやり方です。Range("G1").Value ではなくて、「実績」の方のG1 の値のはずです。

なお、当たり前ですが、「標準モジュール」に登録してください。

Sub Test1()
  Dim mDate As String
  Dim Ret As Variant
  With Worksheets("実績")
    mDate = Format(.Range("G1").Value, "m-dd")
    Ret = Evaluate("='" & mDate & "'!A1")
    If Not IsError(Ret) Then
      If MsgBox("既に、" & mDate & " シートはあります。" & vbCrLf & _
        "上書きしますか?", vbQuestion + vbOKCancel) = vbCancel Then
        Exit Sub
      Else
        .Cells.Copy Worksheets(mDate).Range("A1")
      End If
    Else
      .Copy After:=Worksheets("実績")
      ActiveSheet.Name = mDate
    End If
  End With
End Sub

こんばんは。

>ActiveSheet.Name = Format(Range("G1").Value, "m-dd")

意味は分かるのですが、こういうコードは、確かにこれで通るのですが、かなり乱暴なやり方です。Range("G1").Value ではなくて、「実績」の方のG1 の値のはずです。

なお、当たり前ですが、「標準モジュール」に登録してください。

Sub Test1()
  Dim mDate As String
  Dim Ret As Variant
  With Worksheets("実績")
    mDate = Format(.Range("G1").Value, "m-dd")
    Ret = Evaluate("='" & mDate & "'...続きを読む

QエクセルのVBAでシート名が重なるときの処理 

お世話になります。
エクセルのVBAにてリストボックスで選択した単語をシート名に
反映させるマクロを作成しました。

が、一度シート名を作ると2回目に同じ単語を選択すると、
デバック?画面になってしまいます。
『同じ名前のシート名は作れません・・・』

希望としては、同じ名前が出たら自動に連番が割り振られる
ようなものを希望しています。

マクロの記録で確認しても、やはり同じデバック要画面がでます。
別シートにシート名を反映させて、同じ名前がヒットしたら
文字列を追加して、そのシートに反映し続ける・・・
ようなことは考えられますが、どうも不細工で気が向きません。

もっとスマートな考えがあれば教えていただきたく
よろしくお願いします。

参考に作ったVBAを下記します。
これだと、途中でシートを削除してしまうと
デバック画面が発生してしまいます。
(マクロの切り抜きなので、
 リストで選択したものが反映されるマクロではありません)

Dim シート名 As String
Dim n As Integer

Sheets("伝票マスター").Select
Worksheets("伝票マスター").Copy before:=Worksheets("伝票マスター")


n = Sheets.Count
Sheets("伝票マスター (2)").Select
ActiveSheet.Name = "伝票" & n - 1
Range("D2") = n - 1
Range("D1").Select

お世話になります。
エクセルのVBAにてリストボックスで選択した単語をシート名に
反映させるマクロを作成しました。

が、一度シート名を作ると2回目に同じ単語を選択すると、
デバック?画面になってしまいます。
『同じ名前のシート名は作れません・・・』

希望としては、同じ名前が出たら自動に連番が割り振られる
ようなものを希望しています。

マクロの記録で確認しても、やはり同じデバック要画面がでます。
別シートにシート名を反映させて、同じ名前がヒットしたら
文字列を追加して...続きを読む

Aベストアンサー

こんばんは。

こんな感じにしたらどうでしょうか。
On Error GoTo で処理するほうが良いのですが、それを発生させるために、Active やSelect を使うと、画面が動きますから、WorksheetFunction で値を取ります。On Error Resume Next ですと、値が確保できませんから、Variant 型の変数の中に、Null 値を入れる方法を取りました。Null値はワークシートでは発生しません。別にどんな方法でもよいのですが、シートの位置に関係なくシート名をチェックしないとうまくありません。

ブックに伝票マスターがない場合の処理を入れておきました。

'-------------------------------------------
Sub Test1()
  Dim i As Integer
  Dim ret As Variant
  Dim n As String
  Const SHN As String = "伝票マスター"
  
  On Error GoTo ErrHandler
  Worksheets(SHN).Select
  For i = 1 To ActiveWorkbook.Worksheets.Count
    On Error Resume Next
    ret = Null
    n = "伝票 - " & CStr(i)
    ret = Worksheets(n).Range("A1").Value
    If IsNull(ret) Then Exit For
    On Error GoTo 0
  Next i
  Application.ScreenUpdating = False
  Worksheets(SHN).Copy Before:=Worksheets(SHN)
  With ActiveSheet
    .Name = n
    .Range("D2") = i
    .Range("D1").Select
  End With
  Application.ScreenUpdating = True
  Exit Sub
ErrHandler:
  If Err.Number = 9 Then
    MsgBox "アクティブブックには、" & SHN & "がないように思われます。", vbExclamation
  End If
End Sub
'-------------------------------------------

こんばんは。

こんな感じにしたらどうでしょうか。
On Error GoTo で処理するほうが良いのですが、それを発生させるために、Active やSelect を使うと、画面が動きますから、WorksheetFunction で値を取ります。On Error Resume Next ですと、値が確保できませんから、Variant 型の変数の中に、Null 値を入れる方法を取りました。Null値はワークシートでは発生しません。別にどんな方法でもよいのですが、シートの位置に関係なくシート名をチェックしないとうまくありません。

ブックに伝票マスターがない...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qエクセル:シート名を手入力でなく、セル「A1」の文字を出したい。

いつもお世話になります。
エクセルのシート名についての質問です。
いつもはシート名を変えるとき、シートタブの上を右クリックして「変更」しています。

◆そこで、
(1) セル「A1」に入力されてある文字を自動で出す
(2) もしくはマクロボタンを押すと「A1」に入力されてあるものが「シート名」として変わる

というようにしたいのですが、その方法について教えてください。よろしくお願いいたします。

Aベストアンサー

こんにちは。


(1)の場合は、下記のコードを ThisWorkbook に記述してください。
どのワークシートでも機能します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value
End Sub


(2)場合は、下記のコードを標準モジュールに記述しボタンにマクロ登録してください。
(すべてのシートにボタンを貼り付けるのは面倒でしょうから、ツールバーにボタンとして追加すると良いと思います。)

Public Sub SheetName()
ActiveSheet.Name = Range("A1").Value
End Sub

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む

QVBA シートをコピーした時、同名の場合は注意喚起

いつもお世話になります。
WINDOWS7 EXCELL2010 です。

下記のマクロで例えば、
「1018」というシートが既に存在していて新たに「1018」を作成しようとした時に重複の注意喚起メッセ―ジを出すには下記のマクロにどうすればいいか御指導いただけませんでしょうか。

注意喚起メッセージは  「既に、同名のシートがあり再度入力して下さい。」
※If MsgBox("既に、同名の シートがあり再度入力して下さい。")

参考に
Private Sub CommandButton1_Click()

Dim NewSheetName As String

NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください。例 0101")

Sheets("元本").Copy After:=Sheets("元本")
With ActiveSheet
.Name = NewSheetName
With .Range("A1")
.NumberFormatLocal = "0000"
.Value = NewSheetName
End With
.OLEObjects("CommandButton1").Delete
.Range("A2").Select
End With
Sheets("元本").Activate
Application.ScreenUpdating = True

End Sub

いつもお世話になります。
WINDOWS7 EXCELL2010 です。

下記のマクロで例えば、
「1018」というシートが既に存在していて新たに「1018」を作成しようとした時に重複の注意喚起メッセ―ジを出すには下記のマクロにどうすればいいか御指導いただけませんでしょうか。

注意喚起メッセージは  「既に、同名のシートがあり再度入力して下さい。」
※If MsgBox("既に、同名の シートがあり再度入力して下さい。")

参考に
Private Sub CommandButton1_Click()

Dim NewSheetName As String

NewSheetName = Inpu...続きを読む

Aベストアンサー

> ご回答いただいたのをそのまま反映したものが下記の 「1」 ですがテストしたところシートのコピーなど何も反応しませんでした。

回答は、同一シート名に対し注意喚起し再入力を求めるという部分のコードですから、回答1の最後に「以下に新規作成のコード 」と記載しているように、質問のSheets("元本").Copy After:=Sheets("元本")以下のコードをそのまま記載してください。

> 私なりにご回答を編集追加したところ、
> シートはコピーされ 同名のシート名は「既に、同名の シートがあり再度入力して下さい。」
> までは上手くできました。
> ただしその後は下記のようなコーションが出ました。
> 解決策を再度ご指導いただけませんでしょうか。

一番大事なdo~Loopを取り除いてますから、同じシート名を見つけてもその旨表示するだけで再度入力をさせるようになっていません。その為に、重複するシート名のまま先に進み名前変更しようとしてますから当然「同じシート名で変更しようとしている」というエラーになります。

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング