- ベストアンサー
2000と2003のマクロの構成に違いありますか？
2000でマクロを作成し正常に使用していたのですが、2003に変更後、一部エラーが出るようになってしまいました。 ------------------------------------------------ ActiveCell.SpecialCells(xlLastCell).Select cend = ActiveCell.Row Dim p As Variant Dim re As Integer re = MsgBox("担当者のみです。実行しますか？", vbYesNo + vbQuestion + vbDefaultButton2) If re = vbYes Then p = Application.InputBox(Prompt:="送信する月を入力。 (例:10月の場合) 10/ (半角)", Type:=2) If p = False Then Exit Sub '指定以外を非表示 For i = 2 To cend If InStr(1, Cells(i, 2), p, 1) > 0 Then GoTo pas1 'ElseIf InStr(1, Cells(i, 2), "12/", 1) > 0 Then ' GoTo pas1 Else Rows(i).EntireRow.Hidden = True End If pas1: Next Else Exit Sub End If '表示行選択 Range(Cells(1, 1), Cells(cend, 15)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 'シ－ト"mySheetA"を追加しそこに貼り付け Sheets.Add.Name = "新規" ActiveSheet.Paste 'Range("C1").Select End Sub ------------------------------------------------ 以上のようなマクロです。 最初の部分の“cend”あたりで引っかかってしまうようです。どなたかお願いします。
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
関連するQ&A
- どなたかマクロの修正お願いします。
以下のようなマクロを作りました。 ----------------------------------------------- Private Sub CommandButton1_Click() ActiveCell.SpecialCells(xlLastCell).Select cend = ActiveCell.Row Dim p As Variant Dim re As Integer re = MsgBox("この作業は担当者のみです。実行しますか？", vbYesNo + vbQuestion + vbDefaultButton2) If re = vbYes Then p = Application.InputBox(Prompt:="送信する月を入力。 (例:10月の場合) 10(半角)", Type:=2) '指定以外を非表示 For i = 2 To cend If InStr(1, Cells(i, 2), p, 1) > 0 Then GoTo pas1 Else Rows(i).EntireRow.Hidden = True End If pas1: Next Else Exit Sub End If '表示行選択 Range(Cells(1, 1), Cells(cend, 15)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 'シ－ト"mySheetA"を追加しそこに貼り付け Sheets.Add.Name = "新規" ActiveSheet.Paste Dim Sh1 As Worksheet Set Sh1 = Worksheets("新規") Dim outPath As String outPath = "C:\Documents and Settings\****\デスクトップ\人事ファイル\" Dim sheetNum As Integer Sheet = "新規" Sheets("新規").Activate ActiveSheet.SaveAs Filename:=outPath & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False Sheets("新規").Activate ActiveWorkbook.SendMail Recipients:="****@****.co.jp", Subject:="シート（テスト）" End Sub ------------------------------------------------- 二つ目のメッセージ、InputBoxの部分で「OK」をクリックしたら作業を引き続き実行し、「キャンセル」なら中止としたいです。どなたかお願いします。
- ベストアンサー
- Visual Basic
- Do loopのマクロ
以下のマクロの問題点を教えていただきたいのです。 A列を上から順番に調べて、値が10のときだけBに分岐して処理を行い（処理の内容は省略してあります）、またAに戻って、空白のセルが見つかったら処理をやめる、というマクロです。 ところが、これを実行すると空白のセルが見つかってもマクロが止まりません。何が問題でしょうか。 Sub A() Cells(1, 1).Select A: Do Until ActiveCell.Value = "" If ActiveCell.Value = 10 Then GoTo B End If ActiveCell.Offset(1, 0).Select Loop B: ActiveCell.Offset(1, 0).Select GoTo A End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで
お世話になります 下記のマクロで実行した所 １００まで書式設定で保護、ロックしたいのですが b3：l3はロックするものの ４行目以降はロックしません どうしたらいいでしょうか もう１つ、このシートはいつもｃ３からはじめたいのですが If ActiveCell.Value >= "" Then の部分はどうしたらいいでしょうか よろしくおねがいいたします 初心者でバカな質問ですみません Sub マクロ１() Dim i As Integer For i = 1 To 100 If ActiveCell.Value >= "" Then Range("B3:l3").Select Selection.Locked = True Selection.FormulaHidden = False End If ActiveCell.Offset(1, 0).Select Next End Sub
- ベストアンサー
- Visual Basic
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- このマクロ、どこがおかしいですか？
i5とj5のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i5とj5のセルに何も書かれていないときはそのまま一つ下の列へ行き、行った先のセルでも同じように処理(i6とj6のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i6とj6のセルに何も書かれていないときはそのまま一つ下の列へ行き)を繰り返し、と言うことをi33とj33のセルまで続けたいと思っています。 Sub よろしくお願いします() Dim i As Integer For i = 5 To 33 Cells(i, 9).Select If Cells(i, 9).Value = Cells(i, 10).Value Then Range(Cells(i, 9), Cells(i, 10)).Merge Selection.Offset(i + 1).Select ElseIf Cells(i, 9).Value = "" Then Selection.Offset(i + 1).Select Next i End If End Sub と書いたのですが、『Nextに対応するForがありません』と言われてしまいます。どうすれば思い通りにできるでしょうか？ 極めて初心者で、伝わりにくい点があるかもしれません。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 複数セルの色付けについて
マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1 、問2_2 、問2_10 （全部で問は2_28まであります）等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか？ どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub
- 締切済み
- Visual Basic
- 選択範囲の空白セルに0を入れるマクロ
Private Sub CommandButton1_Click() If Cells("選択範囲").SpecialCells(xlcellTypeblank).Select Then Range("選択範囲").Value = 0 End If End Sub このマクロを作成したのですが、動きません。 どこが、おかしいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- 下記のマクロをもっと早くするには？
下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub
- 締切済み
- Visual Basic
- VBAでIF文を作成したが、もう少しまとめたい。
以下のようなＶＢＡを作成しました。 動作に問題はないのですが、 もっと簡単にまとめることができる気がしますが、うまくできません。 何かやりかたはあるのでしょうか。 宜しくお願い致します。 If Cells(5, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(5, 1) End If If Cells(6, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(6, 1) End If If Cells(7, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(7, 1) End If If Cells(8, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(8, 1) End If If Cells(9, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(9, 1) End If If Cells(10, 1).Value = Cells(1, 1).Value Then Cells(100, 100).Select ActiveCell.FormulaR1C1 = Cells(10, 1) End If
- ベストアンサー
- Visual Basic
- 列幅、行の高さを指定するマクロ
元マクロ初心者(今はほとんど忘れています)です。 列幅、行の高さを変更するマクロを以前作りました。 セルに指定する列幅を入力するのですが、 最近１００以上の値の時はスキップされることに気づきました。 １００以上の値でも処理されるようにするにはどうすればよいでしょうか。 Sub 列幅変更マクロ() ' ' Macro1 Macro ' マクロ記録日 : 2004/1/31 ユーザー名 : ' 列幅の変更 ' Keyboard Shortcut: Ctrl+l ' If MsgBox("→：列幅を変更します。右の方向にセル内の数値に従って処理しています。一番右のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.ColumnWidth = ActiveCell.Value End If End If ActiveCell.Offset(0, 1).Select Loop End If End Sub Sub 行の高さ変更マクロ() ' ' Macro2 Macro ' マクロ記録日 : 2004/2/1 ユーザー名 : ' 行の高さ変更 ' Keyboard Shortcut: Ctrl+p ' If MsgBox("↓：行の高さを変更します。下の方向にセル内の数値に従って処理しています。一番下のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.RowHeight = ActiveCell.Value End If End If ActiveCell.Offset(1, 0).Select Loop End If End Sub
- ベストアンサー
- オフィス系ソフト
- ドイツのブラウンシュバイツでの仕事中、メーベンピックホテルに滞在した体験を語る。
- ホテルの地下には驚くべき温泉があり、全裸の男女が集う不思議な空間が広がっていた。
- 刺激的な談笑や意外な遭遇が満載の、このユニークな施設は現在も存在するのだろうか？
