- ベストアンサー
VBAで複数のシート名を置換する処理
Dim ws As Worksheet Dim i As Long For i = 1 To ThisWorkbook.Sheets.Count For Each ws In ThisWorkbook.Sheets If ws.name Like "*T*" Then ws.name = Replace(ws.name, "T", "S") End If Next Next End Sub この処理をするとnameメソッド失敗worksheetオブジェクト 処理できるようにするにはどうすればいいんでしょうか
- karasumina
- お礼率21% (6/28)
- Visual Basic
- 回答数2
- ありがとう数0
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
一例です。 If文は不要ではないでしょうか。 その１ Dim ws As Worksheet For Each ws In Worksheets ws.Name = Replace(ws.Name, "T", "S") Next その２ Dim i As Long For i = 1 To Sheets.Count Sheets(i).Name = Replace(Sheets(i).Name, "T", "S") Next
その他の回答 (1)
- mt2008
- ベストアンサー率52% (885/1701)
変更後のシート名がすでに使われていないかどうかはチェックした方が良いと思います。 Sub Sample() Dim ws As Worksheet Dim sName As String Dim rtn '*** 変更後のシート名がダブらないかチェック For Each ws In Worksheets sName = Replace(ws.Name, "T", "S") If sName <> ws.Name Then On Error Resume Next rtn = 0 rtn = Sheets(sName).Index If rtn <> 0 Then MsgBox ("変更後のシート名(" & sName & ")と同名のシートが存在しています") Exit Sub End If On Error GoTo 0 End If Next '*** シート名変更 For Each ws In Worksheets ws.Name = Replace(ws.Name, "T", "S") Next End Sub
関連するQ&A
- 複数のエクセルシートをまとめるマクロ
下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBA シート名の部分一致検索について エクセル2007
VBAでエクセルの全シート名を部分一致で検索したいと考えています。 そこで以下のコードを書いたのですが、 インプットボックスにどんな文字列を入力しても全てのシート名を 取得してしまって途方にくれています。 どなたかお助けください。 Sub test01() Dim name As String Dim ws As Worksheet shn = InputBox("検索文字列を入力") For Each ws In ThisWorkbook.Worksheets If ws.Name Like " * " & name & " * " Then ws.Activate MsgBox ws.Name End If Next ws End Sub
- 締切済み
- オフィス系ソフト
- 複数シートを順番に範囲指定してソートしたい
以下のコードでアクセスからデータをエクスポート後に 複数（50くらい）シート名を変更し、シートを並び替えし、 列幅を整えています。 次にデータをソートしたいのですが、うまく範囲指定が できないで２日くらいすぎてしまいました。 以下の**でかこった部分で定義ができません。 どなたかお助けしていただけないでしょうか？ よろしくお願いします。 うまく改行できないですいません・・。 **************************************************** h = 1 o = 29 ws.Columns(h & ":" & o).Select 範囲指定したいのはA列からAC列までのデータの入った 行数までです。 With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP)) **************************************************** Private Sub CommandButton1_Click() Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, i& Dim intLoopA As Integer Dim intLoopB As Integer Dim h As Long Dim o As Long path = ThisWorkbook.path & "\" wbName = Dir(path & "*.xls") Do Until wbName = "" If wbName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(path & wbName) i = 2 For Each ws In wb.Worksheets If Trim(ws.Range("A2")) <> "" Then On Error Resume Next ws.Name = ws.Range("A2") If Err.Number <> 0 Then ws.Name = ws.Range("A2") & " (" & i & ")" i = i + 1 End If On Error GoTo 0 End If For intLoopA = 1 To Sheets.Count For intLoopB = 1 To Sheets.Count - 1 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then Sheets(intLoopB).Move after:=Sheets(intLoopB + 1) End If Next intLoopB Next intLoopA With ws.Rows(1) With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft)) .Interior.ColorIndex = 15 .EntireColumn.AutoFit End With End With h = 1 o = 29 ws.Columns(h & ":" & o).Select With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP)) .Sort _ Key1:=Range("G1"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal End With End With DoEvents Next wb.Save End If wbName = Dir Loop Set wb = Nothing Set ws = Nothing MsgBox "処理が完了しました。", vbInformation, "処理確認" End Sub
- 締切済み
- オフィス系ソフト
- [VBA] For文の使い分けについての疑問
こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windows7 pro 64bit Office=Excel2010(14.0.7128.5000) ・疑問点 For each nextもFor nextも、最下行まで処理をしたいときに使用することが多いのですが、 単列の場合はFor each next、複数列の場合はFor nextというような使い方をしています。 例：For each next Sub test() Dim ws As Worksheet Dim r As Range Dim endRow As Long Set ws = ThisWorkbook.Sheets(1) endRow = ws.Cells(Rows.Count, 1).End(xlUp).Row For Each r In ws.Range("A1:A" & endRow) If r.Value Mod 2 = 0 Then r.Font.Bold = True Next r End Sub 例：For next Sub test2() Dim ws As Worksheet Dim i As Long Dim endRow As Long Set ws = ThisWorkbook.Sheets(1) endRow = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To endRow If ws.Cells(i, 1).Value Mod 2 = 0 Then ws.Cells(i, 1).Font.Bold = True If ws.Cells(i, 2).Value Mod 3 = 0 Then ws.Cells(i, 2).Font.Bold = True Next i End Sub 単純に、複数列での処理をする場合にはFor each next文を2つ書かないといけないと思い（込み）、 上記のような運用にしていますが、そもそもこの考え方は合っていますでしょうか？ 単列の処理であってももちろんFor next文で問題なく使用できますし、 複数列の処理の場合もFor each next文で処理することはできます（冗長ですが）が、 VBA的に正しいというか、合理的な考えであるのかどうかが疑問です。 みなさんはFor each nextとFor nextをどのように使い分けていますか？ 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- Excel VBA 指定シートの有無確認
指定した名前のシートがあるかないか判断させてますが、 以下のやりかたでは、 グラフ作成したシートを認識してくれません。 そのようにすれば良いでしょうか？ Dim ws As Worksheet, flag As Boolean For Each ws In Worksheets If ws.Name = "シート" Then flag = True Next ws If flag = True Then msgbox "あります Else Sheets.Add ActiveSheet.Name = "シート" End If
- ベストアンサー
- Visual Basic
- VBA 請求データ一覧からの複数の処理
先週 kkkkkmさんに質問をさせて頂きまして、 いろいろご指導を頂いたものです。 続編の様な形になってしまいますが、 抽出するデータの環境設定を変更致しました。 ご質問させて頂く内容は前回とほとんど変更がないのですが、 あらためて下記に記載させて頂きます。 <Worksheet1のデータ> Ｊ列～AM列までが課税金額 「J,K,L」「M,N,O」・・・「AK,AL,AM」と3列1組（コード・費目・金額） 1組の行もあれば、複数組の行もあり。 AN列～BB列までが非課税金額 課税金額と同じく3列1組 1組の行もあれば、複数組の行もあり。 「BC」=消費税、「ＢＤ」=合計金額 ※AN列の前に不規則な空白セルあり BC列の前に不規則な空白セルあり 文章で上手く説明出来ているか自信がありませんので、 エクスポートした元データ Worksheet1と、 vbaを用いて作成した Worksheet3 をご参考に添付致します。 Worksheet1の2行目がWorksheet3の2行目に対応しています。 3行目、4行目も同様です。 不規則な空白が原因でしょうか・・・。 M列、O列は問題ないのですが、 金額が合わなかったり、N列に金額を引いてこないのです。 実行しているコードは下記になります。 Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet Dim mTotal(4) As Long Dim LastRow As Long Dim List(4) As Variant Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") Set Ws3 = Sheets("請求書ひな形") List(1) = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value List(2) = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value List(3) = Ws2.Range(Ws2.Cells(1, "C"), Ws2.Cells(Rows.Count, "C").End(xlUp)).Value List(4) = Ws2.Range(Ws2.Cells(1, "D"), Ws2.Cells(Rows.Count, "D").End(xlUp)).Value LastRow = UBound(List(1)) For i = 2 To 4 If LastRow < UBound(List(i)) Then LastRow = UBound(List(i)) End If Next For i = 2 To Ws1.Cells(Rows.Count, "J").End(xlUp).Row mTotal(1) = 0 mTotal(2) = 0 mTotal(3) = 0 mTotal(4) = 0 For j = Columns("J").Column To Columns("BB").Column Step 3 For k = 2 To LastRow If UBound(List(1)) >= k Then If Ws1.Cells(i, j).Value = List(1)(k, 1) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(2)) >= k Then If Ws1.Cells(i, j).Value = List(2)(k, 1) Then mTotal(2) = mTotal(2) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(3)) >= k Then If Ws1.Cells(i, j).Value = List(3)(k, 1) Then mTotal(3) = mTotal(3) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(4)) >= k Then If Ws1.Cells(i, j).Value = List(4)(k, 1) Then mTotal(4) = mTotal(4) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If Next Next Ws3.Cells(i, "J").Value = mTotal(1) Ws3.Cells(i, "K").Value = mTotal(2) Ws3.Cells(i, "L").Value = mTotal(3) Ws3.Cells(i, "N").Value = mTotal(4) Ws3.Cells(i, "M").Value = Ws1.Cells(i, "BC").Value Ws3.Cells(i, "O").Value = Ws1.Cells(i, "BD").Value Next Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing End Sub 本当に何度も申し訳ございません。 お時間がある時に見て頂けると有り難いです。 どうぞ宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- VBA最終列の取得/不規則な処理
VBAにて、最終列の取得ができません。 また、繰り返し処理を3列処理、step5、3列処理、step5…と繰り返し行う方法もご教授いただきたいです。 エクセルはo365を使用しております。 ①最終列の取得 実際は300列近くの表になります。 最終行は取得できたのですが、最終列がなぜかエラーも出ず、処理が行われません。 ②不規則な繰り返し処理 画像の水色部分のみ処理を行いたいです。 3列処理と記載したのですが、セル結合しているので、考え方が合っているのかも不明です。 塗りつぶされているセル一つ一つに処理を行いたいです。 また、行列共に可変します。 実行したいマクロは、選択したブックのSheets(1)の表の中の水色に入力されている文字列が「1」か「2」か判断するというものです。 「１」と入力されていれば → 別ブックのA1セルに１をカウント 「２」と入力されていれば → 別ブックのB1セルに１をカウント ※水色セルは参考で用意したものなので、実際は塗りつぶしされていません。 ※空白のセルもあります ①②の解消法のご教授をよろしくお願い致します。 =============================================== Option Explicit Sub kurikaeshi() Dim retu As Long, gyou As Long Dim File As Workbook Set File = Workbooks("test.xlsx") Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = File.Sheets(1) Set ws2 = ThisWorkbook.Sheets(1) Workbooks.Open FileName:=ThisWorkbook.Path & "/" & File For retu = 2 To ws1.Cells(4, ws1.Columns.Count).End(xlToLeft).Column 'ここが処理されません For gyou = 4 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Rows If ws1.Cells(gyou, retu).Value = "1" Then ws2.Range("A1") = ws2.Range("A1") + 1 If ws1.Cells(gyou, retu).Value = "2" Then ws2.Range("B1") = ws2.Range("B1") + 1 End If Else Exit Sub End If Next gyou Next retu End Sub
- ベストアンサー
- Visual Basic
- VBAでワークシートを変数にするとき
たとえばSheet1とSheet2を一度に選択する場合、 Sub Macro6() Sheets(Array("Sheet1", "Sheet2")).Select End Sub と書くと思います。 ワークシートを変数で書く場合は Sub test() Dim ws1 As Worksheet, ws2 As Worksheet Sheets(Array(ws1.Name, ws2.Name)).Select End Sub と、いちいち名前で指定しなければならないのでしょうか？ それとももっと別の書き方があるのでしょうか？
- ベストアンサー
- その他MS Office製品
- VBAですべてのワークシートを処理したい
ブック内の全ワークシートに対して同じ処理をするために、 For each ワークシート in Worksheets ～処理～ Next ワークシート を使ってみたのですが、その時にアクティブになっているシートしか処理されません。たとえば次のようなシンプルなコードでも、同様です。何が抜けているのでしょうか。 Sub allworksheets() Dim WS As Worksheet For Each WS In Worksheets Range("a1") = "123" Next WS End Sub マクロの勉強を始めたばかりで、基本的なことでつまづいてます。よろしくお願い致します。
- ベストアンサー
- Visual Basic
