痔になりやすい生活習慣とは?

エクセルVBAにて

原紙とゆう名前のワークシートをコピー処理して
入力フォームにテキストボックス1と2があり
コピーした原紙とゆうワークシート名から
テキストボックス1と2に入力した項目が
合わさってワークシート名に変更する方法はあるのでしょうか?

例)テキストボックス1に 123
  テキストボックス2に 456
コマンドボタン1をクリックすることによって
ワークシート名が123456となるようにしたいのですが?
宜しくお願いいたします。

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

A 回答 (3件)

こんにちは。



#2の回答者です。気に入るかどうか分かりませんが、

ひとつのアイデアなのです、単に、シート名に入れられない文字列ではじくよりも、今のコードのままで、その「/」を抜くという方法がありますね。

特に、日付という前提ではないのですが、11/09 などの日付の、「/」を取り去るシートエラーチェックはいかがでしょうか?ただし、今回は、「/(半角)」も「/(全角)」も同じに扱いますから、これらの文字がある限りは、取り去ってしまいます。

以下のコードを、そのまま置き換えてくださるか、

ByRef ShName As String の ByRef (参照渡し)を入れ、
For Each ~ Next v の間を入れ替えてくだされば可能です。

---------------------------------------------------------------

Private Function ShNameCheck(ByRef ShName As String) As Boolean
'シート名のエラーチェック
  Dim v As Variant
  Dim i As Integer
  Dim sh As Object
  If Len(ShName) > 30 Then ShNameCheck = False: Exit Function
  buf = ShName
  For Each v In Array(":", "\", "/", "?", "*", "(", ")", " ")
    buf = Replace(buf, v, "", , , vbTextCompare) '変更点
  Next v
  ShName = buf
  For Each sh In ActiveWorkbook.Sheets
    If StrComp(sh.Name, ShName, vbTextCompare) = 0 Then ShNameCheck = False: Exit Function
   Next sh
  ShNameCheck = True
End Function
---------------------------------------------------------------
    • good
    • 0
この回答へのお礼

お手数をかけてすみません。
本当にありがとうございます。
思っていたとうりに動きます。
まだまだ、勉強不足で知らないことばかりですが
上記のわからない場所の意味を理解しておきます。

お礼日時:2007/11/07 13:42

こんばんは。



エラーフリーになるように、作ってみましたが、他にも問題が出るかもしれません。

---------------------------------
UserForm1
TextBox1, TextBox2
CommandButton1
---------------------------------
'ユーザーフォーム・モジュール

Private Sub CommandButton1_Click()
  Dim ShName As String
  If TextBox1.Text <> "" Then '少なくとも片方のテキストボックスに入力
    ShName = TextBox1.Text & TextBox2.Text
    If ShNameCheck(ShName) Then
      With ActiveWorkbook
        .Worksheets("原紙").Copy After:=.Worksheets(Worksheets.Count)
        ActiveSheet.Name = ShName
      End With
    Else
      MsgBox "その名前はふさわしくありません: " & ShName, 48
      TextBox1.Text = "": TextBox2.Text = ""
    End If
  End If
End Sub

Private Function ShNameCheck(ShName As String) As Boolean
'シート名のエラーチェック
  Dim v As Variant
  Dim i As Integer
  Dim sh As Object
  If Len(ShName) > 30 Then ShNameCheck = False: Exit Function
  For Each v In Array(":", "\", "/", "?", "*", "(", ")", " ")
    i = InStr(1, ShName, v, vbBinaryCompare)
    If i > 0 Then ShNameCheck = False: Exit Function
  Next v
  For Each sh In ActiveWorkbook.Sheets
    If StrComp(sh.Name, ShName, vbTextCompare) = 0 Then ShNameCheck = False: Exit Function
   Next sh
  ShNameCheck = True
End Function

この回答への補足

ありがとうございます。
エラーチェックまで考えていただき感謝です。

誠にすみません、もうひとつお願いがあります。
テキストボックス1に 11/09 などの日付を
入れる場合があるのですが、この場合
テキストボックス2に 1 を入れた場合
ワークシート名は 11091 にしたいのですが
出来ますでしょうか?
すみません。

補足日時:2007/11/07 09:33
    • good
    • 0

シートをコピーし、シート名を変更する作業をマクロの自動記録


してみてください。

生成されたコードを若干改造すればお望みの形になると思います。
    • good
    • 0

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

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

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

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

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

QExcel VBA セルの値をシート名にしたいのです。

こんばんは
新しくシートを挿入させて、「シート2」の値のみをコピーさせたいと考えています。
その新しく挿入させたシート名を「シート1」のせるA3とA4の文字列をあわせたものにしたいのですが、どうしたらよいのでしょうか。
途中まで考えたところでいきずまってしまいました。
どうか英知をお貸しください。
宜しくお願い致します。

A3には日付、A4には名前が入力されています。

Dim sheetName As String

Worksheets("月度集計").Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Worksheets("Sheet1").Cells(3, 3).Value

On Error Resume Next
Worksheets(1).Name = sheetName
On Error GoTo 0
Range("f2").Select

Aベストアンサー

例として。
・シート2をコピペして新しいシートを作成する
・新シートの数式を値に変更する
・新シートの名前をシート1のA1日付(シリアル値) _ B1の名前とする
 ⇒20090627_n-jun など

Sub try()
Dim ws As Worksheet

Worksheets("Sheet2").Copy After:=Worksheets(Worksheets.Count)
Set ws = ActiveSheet

With ws.UsedRange
.Value = .Value
End With

With Worksheets("Sheet1")
ws.Name = Format(.Range("A1").Value, "yyyymmdd") & "_" & _
.Range("B1").Value
End With

Set ws = Nothing

End Sub

ご参考になれば幸いです。

QExcelのVBAでシート名を指定してシートを挿入(追加)したい。

変数の値をSheet名にしてシートを追加したいのですが、どのようにしたらいいのでしょうか?

Aベストアンサー

Sub test01()
Dim a As String
a = Range("a1")
a = "合計表3"
Workbooks("book1").Worksheets.Add
x = Worksheets.Count
MsgBox x
Workbooks("book1").Worksheets(x).Name = a
End Sub
aはどちらか採用してください。
MsgBox xは不用になれば削除して下さい。
まずSheetを1つ増やして、名前を好きなものに
変更すると言うイメージです。「好きな名前のシート
を作る」というイメージに囚われて、かって私もつまずきました。
それはSheetsコレクションに、Createなどするのでなく、
Addするという考えにあるようです。

Q【Excel VBA】マクロでExcel自体を終了させたい

環境:WindowsXP、Excel2003

マクロでエクセルを終了(ブックを閉じて、アプリケーション自体も終了)させたいのですが、以下のコードではアプリケーションが閉じてくれません。

ThisWorkbook.Close
ExcObj.Quit
Application.Quit

どこか悪いところはありますでしょうか?

よろしくお願いします。

Aベストアンサー

普通に考えれば質問者のコードで上手くいきそうですが
hana-hana3さんの回答にもあるようにThisWorkBook.Closeでコード終了となりますので
Application.QuitをThisWorkBook.Closeの前にもってこないといけません。
Application.Quitはそれがあるプロシージャのコードが全て終わるまで
その実行を保留するちょと特別動作をします。

'-------------------------------------
 Application.Quit
 ThisWorkbook.Close
'-------------------------------------
 
 

Q(VBA)特定のシートのみを名前を付けて保存

Excel2003です。
数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。
この非表示の状態で保存するにはどのようにすればよいのでしょうか?
【以下現在のコードです】
------------------------------------------------
Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Cells.Copy ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub
----------------------------------------------------

Excel2003です。
数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。
この非表示の状態で保存するにはどのようにすればよいのでしょうか?
【以下現在のコードです】
------------------------------------------------
Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets(...続きを読む

Aベストアンサー

Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Copy After:=ActiveWorkbook.Sheets(1)
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(1).Delete
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub

でどうでしょう。

Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Copy After:=ActiveWorkbook.Sheets(1)
Application.DisplayAlerts = False
ActiveWorkbook.Sheets...続きを読む

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....続きを読む

QVBAで検索して、行をコピー&追加したい

Excel2010で以下のことをしたいのですが、VBAがあまりできないのでやれません。
どうか助けてください。

・sheet1のA列に検索用の番号(例として商品番号)が入力されています。
・sheet2はデータベースで、A列に商品番号B列に商品名、C列に国名、D列に価格・・~その後J列まで情報が入っています。(行数は1万行)
・sheet1に入っている商品番号でデータベースから行をピックアップし、該当の行をsheet1のB列以降にコピーしたいのです。
(シート3を新しく作っても構いません。やりやすい方で)
・ただし、同じ商品番号で複数の行がヒットしますので、複数の行がヒットしたら行を追加しながら、行をコピーしたいです。

どのように書いたら良いか参考になるURLだけでもご教授ください。
よろしくお願いします。

Aベストアンサー

もう回答が付いてますね、でもせっかく書いたのだからあげときます(笑)

Sub main()

Dim i1 As Long, i2 As Long, i3 As Long
Dim LastRow1 As Long, LastRow2 As Long

'各シートのデータの最終行を取得
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
i3 = 1

Worksheets.Add 'ワークシート3を作成
ActiveSheet.Name = "Sheet3"
'シート1の文字列がシート2にあるか探し、あればシート2の該当行をシート3にコピー
For i1 = 1 To LastRow1
For i2 = 1 To LastRow2
If Worksheets("Sheet2").Cells(i2, 1) = Worksheets("Sheet1").Cells(i1, 1) Then
Worksheets("Sheet2").Cells(i2, 1).EntireRow.Copy Destination:=Worksheets("Sheet3").Rows(i3)
i3 = i3 + 1
End If
Next i2
Next i1

End Sub

もう回答が付いてますね、でもせっかく書いたのだからあげときます(笑)

Sub main()

Dim i1 As Long, i2 As Long, i3 As Long
Dim LastRow1 As Long, LastRow2 As Long

'各シートのデータの最終行を取得
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
i3 = 1

Worksheets.Add 'ワークシート3を作成
ActiveSheet.Name = "Sheet3"
'シート1の文字列がシート2にあ...続きを読む


人気Q&Aランキング