- ベストアンサー
エクセルでのマクロでのループ処理について
cj_moverの回答
こんばんは。 > sNewShNm = Trim(oSh.Range("H8").Text)のところですが > Ｈ８とＨ９の結合での表示というのは難しいでしょうか > 関数でいうと=Ｈ８＆Ｈ９のような感じです。 んーと、 ＶＢＡでの文字列の結合方法をお訊ねでしょうか？ 普通に & 演算子で結合すればいいです。 sNewShNm = Trim(oSh.Range("H8").Text) & Trim(oSh.Range("H9").Text) たとえば、間に "_" を挟むなら sNewShNm = Trim(oSh.Range("H8").Text) & "_" & Trim(oSh.Range("H9").Text) とか。（& 演算子の前後に半角空白が必要です。） 質問文で確認できなかったので保険をかけて .Text プロパティーを用いていますが、 セルＨ８，Ｈ９の値（表示ではなく値）が文字列ならば、 （或いは、値と表示が同じであることが確実か、そもそも値でよかったならば） sNewShNm = Trim(oSh.Range("H8").Value) & Trim(oSh.Range("H9").Value) ,Value プロパティーを用いるのが通常です。 ご質問では現状のシート名が"0000"数字文字列でしたので、 セルＨ８の 値が数値、表示が桁揃えの"テキスト"である（かも知れない）場合 にも対応するように.Textを用いています。 それから、Ｔｒｉｍ()関数は"テキスト"の左右にある（かも知れない）空白を取り除くものです。 （必ずしも必要ではありません） sNewShNm = oSh.Range("H8").Text & oSh.Range("H9").Text または、 sNewShNm = oSh.Range("H8").Value & oSh.Range("H9").Value のような書き方で問題なければ書き換えてもよいです。 できればセルＨ８，Ｈ９も具体例が欲しかったですね。 ところで、シート名に指定できる文字列の長さの上限は大丈夫でしょうか？ その点を含めて、ここではすべてのエラーを回避するようには書けませんので、 ご注意ください。 自己レス、 >> なるべく入門書にあるような基本的な記述を心がけて書きました。 重複処理用の関数 Function UniqName() の記述は例外です。 これは、必要かどうか判らなかったので簡易的にまとめています。 それから、 >>シート総当りでループして、シート名が"0000"書式のを判別 >>した方が、紛れがなく簡単ではないでしょうか。 この点は、私よりも前の回答でも触れられていますが、 ご提示のコードを尊重して書かれた回答として、 シート名を追いかけるから、 指定した名前のシートがない（かも知れない）場合 を想定してエラー処理を加えているもの だということを、ぜひ確認しておいてください。 テキスト（教本の意）として先々、大いに参考になるものだと思います。 学習段階としては、For ～ Next を覚えてから、For Each ～ Next に 進むのが順当でしょうから、私以外の方のものが 本来妥当な回答だったかも知れません。 （私は、エラー処理のほうがハードルが高く感じてしまうんじゃないかな？ と思ってここにお邪魔しましたが、いずれ必要なことには違いありませんので） それでは、また。
noname#252806
関連するQ&A
- エクセル マクロ エラー
Sub 保存() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("1").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("原本").Range("A1:K73").Copy Sheets("1原本").Range("A1") End Sub シートにグラフを乗せたらエラーが出たのですが 解除できないでしょうか？
- ベストアンサー
- Excel（エクセル）
- マクロエラー
実行時エラー１００４結合セルの一部を変更することができません と表示されました なぜでしょうか？ 以前まで使用できていたのですが Sub 作成() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("原本").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("1").Range("A1:K73").Copy Sheets("原本").Range("A1") End Sub Sheets("1").Range("A1:K73").Copy Sheets("原本").Range("A1") この部分で黄色く表示されます
- ベストアンサー
- Excel（エクセル）
- エクセル２０００マクロエラー
下記のマクロを実行すると、Sheets(M_KAKOBA(count)).Selectのロジックでインデック スが有効範囲にありません。というエラーメッセージがでます。 エクセルのツール→オプション→全般→新しいシートの数を2から3に変更すると エラーは発生しないのですが、エクセルのツール→オプション→全般→新しいシートの数を2 のままでエラーを出さないようにするには、ロジックを変更すればできるのでしょうか？ ロジックの追加方法を教えてください。 Sub 送信() '変数の設定 Dim work, hensu, i, j Windows("加工品.xls").Activate work = Sheets("masta").Cells(3, 6).Text 'シート名の変更 Windows(F_NAME).Activate Sheets(M_KAKOBA(count)).Select ActiveSheet.Name = work Windows("加工品.xls").Activate Sheets(work).Select i = 5 Do i = i + 1 hensu = Cells(i, 5) Loop While hensu <> "" Range(Cells(1, 1), Cells(i + 1, 33)).Select Selection.Copy Windows(F_NAME).Activate Sheets(work).Select Range("a1").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A2").Select End With Selection.BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic ' '行の高さ If Worksheets(work).AutoFilterMode = False Then Range(Cells(5, 1), Cells(i + 1, 31)).Select Selection.AutoFilter End If End Sub
- ベストアンサー
- Visual Basic
- エクセルの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 、
- ベストアンサー
- オフィス系ソフト
- マクロについて教えてください。
最近、勉強し始めました。 名簿を作成しています。Sheet1のデータを2種類に分けてSheet2（県外）、Sheet3（県内）のあらかじめ作成している表に振り分けたいのです。 しかしながら、1名分のデータをコピーして張り付けることはしたのマクロで出来たのですが、2名分もこのようにするとなると手入力したほうが速いような気がしています。 なにかいい方法がありましたら教えてください。 Sub コピーして別のシートに貼り付ける1() Worksheets("Sheet1").Activate Range("B11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("B10:E17") Range("C11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A18:E19") Range("D11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F10:K17") Range("E11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F18:K19") Range("F11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M10:S10") Range("G11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M11:S11") Range("H11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M12:S12") Range("I11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M13:S13") Range("J11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M14:S14") Range("K11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M15:S15") Range("L11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M16:S16") Range("M11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M17:S17") Range("N11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M18:S18") Range("O11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M19:S19") Range("P11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("T10:T19") Range("Q11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("U10:U19") Range("R11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("V10:V19") Range("S11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("W10:W19") Range("T11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("X10:X19") Range("U11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Y10:Y19") Range("V11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Z10:Z19") Range("W11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AA10:AA19") Range("X11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AB10:AB19") Range("Y11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AC10:AG19") End Sub
- 締切済み
- その他([技術者向] コンピューター)
- Excel VBA if文 マクロ強制終了するには？
現在 2つのbookがあります。 ・データ data.xls ・集計 total.xls ★条件は以下 ・この2つのbookには同じ名前の 『sheet名・数』が情報保持しています。 ・sheet名は不特定の名前が付けられています。 ★処理したいマクロ内容 ・data.xls …の各sheet と total.xls 各sheet参照させて マッチしたら処理。 マッチしなかったらマクロ強制終了。 Sub match() Dim i As Integer For i = 1 To Worksheets.Count '任意のbookを指定します Windows("data.xls").Activate sheet_copy = ActiveSheet.Name Sheets(sheet_copy).Select '範囲を選択 コピーします Range("C2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy On Error Resume Next '---前後にシートが無い場合のエラーを無視 ActiveSheet.Next.Select '任意のbook と sheet を指定します Windows("total.xls").Activate sheet_paste = ActiveSheet.Name Sheets(sheet_paste).Select Range("D2").Select If sheet_copy = sheet_paste Then ActiveSheet.Paste ActiveSheet.Next.Select Else MsgBox "sheet miss match error！" '★マクロ強制終了 End If Next i End Sub ★部分に何と記述すればよろしいでしょうか? アドバイスお願い致します。
- 締切済み
- Visual Basic
- 複数シートをループさせてマクロを簡素化したい
win7 Excel2007 でマクロ作成中の初心者です。 シート数の変動する複数シートの特定範囲を一枚のシートに右列方向に、値を貼り付けたいです。 自動記録でコード作成しましたが、もっと簡素化して軽くしたいです。 シートに対するループ等の作成ができません。どうかご指導お願いします。 Sub 勤怠最終データ作成() Worksheets(1).Select '1番左のシートを選択 ActiveSheet.Unprotect Range("B29:BM60").Select '複写範囲はすべて同じ Selection.Copy Sheets("総括").Select '値の貼り付けシートはすべて同じ Range("A2").Select '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(2).Select '2枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(3).Select '3枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(4).Select '4枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues 以下省略 End Sub
- ベストアンサー
- Visual Basic
- 簡単マクロ編集
Sheets("Sheet1").Select ←Range("A3:H8") Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 下方にこの操作を繰り返ししたいのですが Dim i As Long Worksheets("Sheet1").Select For i = 3 To 100 Step 6 If Cells(i, "A") = "" Then Exit Sub End If Cells(i, "A").Resize(6, 8).Copy Destination:=Worksheets("Sheet2").Range("A3:H8") Next i 貼付けは値で貼り付けたいと思います。 どう組み合わせればよいですか？
- ベストアンサー
- その他MS Office製品
- エクセルのマクロで繰り返し処理
当方マクロ初心者ですが下記のマクロをCheckBox0～CheckBox23についてコピーするセルを変化させながら繰り返し処理を行いたいのですが、簡単なループ処理で行えますか？ 教えていただければ幸いです。 If CheckBox0.Value = True Then Worksheets("sheets1").Activate 行 = Worksheets("sheets1").Range("e7") 行 = 行 Worksheets("sheets1").Range("g7:t7").Copy Windows("Books1.xls").Activate Sheets("sheets1").Select Range(Cells(行, 15), Cells(行, 15)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End If
- ベストアンサー
- Visual Basic
- マクロでハッパーリンク2
先日、教えて頂いたマクロですが シートの名前を数字または英字（例AAA or 123）のみにすると、うまくいきますが ハイフンを途中で入れると（例ABG-352 or ABCD-03-005)うまくリンクがいきません どこをどこを直せばいいのでしょうか Sub 新しいシートの追加() Dim シート名 As String シート名 = InputBox("新しいシート名を入力してください", "シート名の指定") If シート名 <> "" Then Sheets("sheet2").Copy After:=Sheets("sheet2") ActiveSheet.Name = シート名 Sheets("sheet1").Select Range("B3").End(xlDown).Offset(1).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _ SubAddress:=シート名 & "!A1", TextToDisplay:=シート名 End If End Sub
- ベストアンサー
- その他MS Office製品
お礼
ご回答ありがとうございます。 Ｈ8とＨ9はテキストでした。問題なく出来ました。 助かります。 皆様のご意見の中でエラー回避が重要であることは理解できました。 まだまだハードルが高そうですが地道に勉強してみます。 知識不足なのですがＶＢＡ辞典やＷＥＢ検索で補足しながら作っていますが、たぶん全体の構成が出来ないうちに作りだし、修正や追加などで気がつくと無駄な動きの多いものが出来てしまいます。 もっと全体像を把握してその為のエラー回避や宣言などを考えなくてはいけませんね。勉強します。 cj_mover様にはご丁寧なご指導を頂き感謝しております。 ありがとうございました。 ご回答頂きました皆様にもこの場をお借りして深く感謝いたします。 ご丁寧なご指導ありがとうございました。