実行時エラーが発生する原因と解決策

前へ 次へ
このQ&Aのポイント
  • 特定の操作時に実行時エラーが発生してしまう問題が発生しました。具体的には、「管理」部署のユーザー・シート3人と「総務」部署のユーザー・シート2人を用意し、ログイン時に「総務」の管理職でログインを試みるとエラーが発生します。
  • エラーの具体的な内容は、実行時エラー'1004'であり、'Visible' メソッドが失敗したことを示しています。エラーはws.Visible = False（下から4行目）の箇所で発生しており、この行の処理がうまくいっていないことが原因です。
  • 問題の解決方法として、ログイン時にシートを隠す処理を行う前に、シートが存在するかどうかを確認することが重要です。もしシートが存在しない場合は、エラーメッセージを表示し、ブックを表示して終了させるようにします。また、ログイン後にシートを表示する際には、必ずシートを存在させた状態にしてから表示するようにします。これにより、実行時エラーが発生しなくなるでしょう。
回答を見る
  • ベストアンサー

実行時エラー

先日はご回答いただきありがとうございました。 ご回答いただいた構文を採用してテストしてみましたところ、特定の操作時にエラーが発生してしまいました。 発生条件：「管理」部署のユーザー・シート3人と「総務」部署のユーザー・シート2人を用意 　　　　　「管理」の管理職でログインしたあと、「総務」の管理職でログインを試みるとエラーが発生 発生エラー：実行時エラー'1004' 'Visible' メソッドは失敗しました: '_Worksheet' オブジェクト エラー発生箇所：ws.Visible = False（下から4行目） お手すきの時で構いませんので、宜しければご回答お願いいたします。 ElseIf isManage Then '管理職なら Dim i As Integer For i = 1 To login.Cells(Rows.Count, eColIndex.depcode).End(xlUp).Row On Error Resume Next 'エラートラップ開始 Set ws = Sheets(login.Cells(i, eColIndex.name).Value) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If login.Cells(i, eColIndex.depcode).Value = depcode Then If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません", vbExclamation, "警告" Application.Visible = True 'ブックを表示 End End If ws.Visible = True 'ユーザーのシート表示 Set ws = Nothing ElseIf Not ws Is Nothing Then ws.Visible = False Set ws = Nothing End If Next

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.12

テスト4（「総務」所属の管理職）でログイン Name=テスト4 Name=テスト4 Name=テスト1 Name=テスト2 これはws.Visible = True の後のデータですよね。 テスト4とテスト1、テスト2はdepcode が違うはずなのに変ですね。 For i = 1 To login.Cells(Rows.Count, eColIndex.depcode).End(xlUp).Row を For i = 1 To Toのあとに 実際のユーザー情報シートのdepcodeのある列でデータがある最後の行番号を入れて実行してみてください。ユーザー5人と管理シート5枚で10行まででしたら10です。

oldold_d
質問者

お礼

Set ws = Nothingを個人シート表示コードのws.Visible = Trueの後に持ってきたところ解消しました。 ありがとうございました！

その他の回答 (11)

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.11

「雛形」を手動で非表示にした状態で実行したら1回目でエラーになりますか。

oldold_d
質問者

補足

「雛形」シートを非表示にしても変わりはありませんでした。 また現在、リストに「ユーザー情報」や「雛形」等の有無にかかわらず、所属Ａのユーザーでログイン（管理職か否かは問わない）→「所属Ａ以外の管理職」の順でログインするとエラーが発生することがわかりました。 以下参考としてイミディエイトを貼り付けます。（役職なしユーザーのコード部にもDebug.Printを配置しました。） テスト2（「管理」所属の役職なし）でログイン Name=テスト2 テスト4（「総務」所属の管理職）でログイン Name=テスト4 Name=テスト4 Name=テスト1 Name=テスト2

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.10

更新履歴 年度マスタ カレンダーマスタ ユーザー情報 雛形 がリストに存在した場合管理者以外でログインした場合にはエラーにならないのでしょうか。 あと 上記のシートの部署コードは他の部署と同じ形式(数値もしくは文字列)で統一されてますよね。 ひとつずつリストに入れてみてどれがエラーになるのか確認して原因を探るしかないかもしれません。

oldold_d
質問者

補足

一つずつ追加して確認していってみたところ、「雛形」を追加した時点でエラーが発生するようになりました。 それまでは正常に動作しました。

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.9

別の所属のシートを閉じているような感じですね。 エラーで終わったときに表示されているシートは一個だけでしょうか。 別のPCでもエラーになるのか また 一度以下のシートをリストから外して実行してみてください。 Name=更新履歴 Name=年度マスタ Name=カレンダーマスタ Name=ユーザー情報 Name=雛形

oldold_d
質問者

補足

＞エラーで終わったときに表示されているシートは一個だけでしょうか。 ＞別のPCでもエラーになるのか テスト3シートの1つだけです 別PCで同内容が発生します。 ＞一度以下のシートをリストから外して実行してみてください。 ＞Name=更新履歴 ＞Name=年度マスタ ＞Name=カレンダーマスタ ＞Name=ユーザー情報 ＞Name=雛形 ご指摘頂いた情報をリストから除いてみた結果、現象は発生しなくなりました。 しかし、管理職だと見れてしまうため、できるなら管理者だけで見れるような構成にしたいです。

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.8

もし、最後のシートを非表示にしようとしてエラーになっている場合、先にログインユーザーのシートを開いてからユーザーが管理職かどうかで動作を変更するという手順がいいと思います。 以下の所に入れ込んでください。 Else 'いずれでもないなら個別シートを表示(システム管理者でなければになります) On Error Resume Next 'エラートラップ開始 Set ws = Sheets(Name) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません" Application.Quit '終了 End End If ws.Visible = True 'ユーザーのシート表示 'ここから-------------------------------- If isManage Then '管理職なら Dim i As Integer For i = 1 To login.Cells(Rows.Count, eColIndex.depcode).End(xlUp).Row On Error Resume Next 'エラートラップ開始 Set ws = Sheets(login.Cells(i, eColIndex.Name).Value) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If login.Cells(i, eColIndex.depcode).Value = depcode Then If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません", vbExclamation, "警告" 'Application.Visible = True 'ブックを表示 End End If ws.Visible = True '同一部署ユーザーのシート表示 Set ws = Nothing ElseIf Not ws Is Nothing Then ws.Visible = False Set ws = Nothing End If Next Else '管理職でなければ 'ここまでを入れ込みます---------------- For Each ws In Worksheets '全てのシート If ws.Name <> Name Then ws.Visible = False 'シート名がユーザ名のシート以外Visible=False Next End If　'←これが追加になります。 End If

oldold_d
質問者

補足

コードをご回答通り修正しましたが変わらず実行時エラーが吐かれます。 イミディエイトは以下の通りとなりました。 テスト1ログイン Name=テスト1 Name=テスト4 Name=テスト5 Name=更新履歴 Name=年度マスタ Name=カレンダーマスタ Name=ユーザー情報 Name=雛形 テスト4ログイン Name=テスト4 Name=テスト1 Name=テスト2 Name=テスト3

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.7

なんとなくわかりました。多分すべてのシートを非表示にしようとしてエラーになっているのだと思います。 最初の部署で非表示になっているところへ、新た部署で非表示から始まって非表示されているシートが表示されない状態のままに非表示が続き、表示されているシートがひとつになってしまい、最後の非表示実行でエラーになっている エラーになったときに表示されているシートがひとつだけになっていないでしょうか。

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.6

蛇足ですが 部署の列の管理のセルをどれか一つ選択しslecttestマクロを実行 保存 部署の列の総務のセルをどれか一つ選択しslecttestマクロを実行 その逆順 です

oldold_d
質問者

補足

ご対応ありがとうございます。 モジュールに提示いただいたコードを記述し手順通りに実行しましたところ、ws.Visible = Falseで質問のエラーが出ました。 イミディエイトは以下の通りとなります。 FalseName=テスト1 FalseName=テスト2 FalseName=テスト3 FalseName=テスト4 FalseName=テスト5 FalseName=更新履歴 FalseName=年度マスタ FalseName=カレンダーマスタ FalseName=ユーザー情報

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.5

Name=テスト3 を非表示にしようとしてエラーになっている感じですね…。 先に管理でログインしても総務でログインしても後からの方でエラーになるということですよね…ws.Visible = True はいいけどws.Visible = Falseが駄目というのがちょっと理解できないところです。 実行時エラー'1004'というのはできないことをしようとした場合に出るエラーみたいで、シート名を取得するのに何か変な文字列になってそれを非表示にしようとしてエラーになてるのかと思ったのですが… もしよろしければ以下のコードをユーザー情報シートのモジュールとして記載して、情報シートの部署名のセルを選択して管理→保存→総務とその逆で実行してみてください。なお、イミディエイトウィンドウにはTrueとFalseそれぞれのシート名が羅列されます。 Sub slecttest() Dim isManage As Boolean Dim depcode As String Dim login As Worksheet, ws As Worksheet isManage = True Set ws = Nothing Set login = Sheets("ユーザー情報") depcode = Selection.Value If isManage = False Then MsgBox "flse" ElseIf isManage Then '管理職なら Dim i As Integer For i = 1 To login.Cells(Rows.Count, eColIndex.depcode).End(xlUp).Row On Error Resume Next 'エラートラップ開始 Set ws = Sheets(login.Cells(i, eColIndex.Name).Value) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If login.Cells(i, eColIndex.depcode).Value = depcode Then If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません", vbExclamation, "警告" 'Application.Visible = True 'ブックを表示 End End If ws.Visible = True 'ユーザーのシート表示 Debug.Print "TrueName="; ws.Name Set ws = Nothing ElseIf Not ws Is Nothing Then ws.Visible = False Debug.Print "FalseName="; ws.Name Set ws = Nothing End If Next End If End Sub

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.4

こちらで、ログインとかは除いてフォームのコンボボックスで選択されたユーザーの所属シートを表示するというものを作成して > ユーザーシート3枚を見れる「管理」の管理職で入った後にブックを保存した> 後、2枚見れる「総務」の管理職でログインを試みる これをやってみたのですがエラーにはならないのです。 Debug.Print の結果は正常な氏名がイミディエイトに表示されたんですよね。

oldold_d
質問者

補足

イミディエイトで見た結果こうなりました ※前提 テスト1…「管理」の管理職 テスト2…「管理」の一般職 テスト3…「管理」の一般職 テスト4…「総務」の管理職 テスト5…「総務」の一般職 テスト1でログイン Name=テスト4 Name=テスト5 Name=更新履歴 Name=年度マスタ Name=カレンダーマスタ Name=ユーザー情報 Name=雛形 テスト1でログイン後、テスト4でログイン Name=テスト1 Name=テスト2 Name=テスト3

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.3

Debug.Print ws.Name は Debug.Print "Name="; ws.Name にしておいてください。

oldold_d
質問者

補足

ご回答いただいた3点を実施してみましたが変化はありませんでした。 ユーザーシート3枚を見れる「管理」の管理職で入った後にブックを保存した後、2枚見れる「総務」の管理職でログインを試みると質問のエラーとなります。

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.2

念のために Private Sub Loginbtn_Click() の最初にも Dim ws As Worksheet より後ろに Set ws = Nothing を入れてみてください。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • オブジェクトエラーが出る

    フォームの切り替え時に 同じマクロを使いたく（機能は同じなので） MultiPage1が1枚目の時と2枚目の時で 入力するコンボボックスを変えておこうとしたのですが エラーで動かないようです。 If MultiPage1.Value = 0 Then COMBX = "ComboBox1" ElseIf MultiPage1.Value = 1 Then COMBX = "ComboBox7" End If name = "シート名" Set ws = ThisWorkbook.Worksheets(name) i = 2 Do Until ws.Cells(i, 9) = "" COMBX.AddItem ws.Cells(i, 9).Value　**********ここでエラー i = i + 1 Loop

  • マクロ実行中エラーが発生する

    いつも回答して頂きありがとうございます。 ws.Cells(7, c).ClearContentsの箇所で『excel2010』ではエラーが発生しませんでしたが、『excel2003』ではエラーが発生しました。（オブジェクトが・・・・みたいなコメント有。）原因は何でしょうか？御指導の程宜しくお願い致します。 Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents'ここでエラーが発生 Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub

  • ExcelVBA　所属部署・権限別のシート表示

    VBA初心者です。 エクセルにログインフォームを実装しました。 IDとパスワードを入力してログインボタンを押下すると、ログイン情報が記述されたシートを参照し、IDとパスワードを照合してログインします。 現在、ログイン者が「管理者」権限であるとき、すべてのシートを表示します。 ログイン者が権限を持たない場合、ログイン者個人のシートが表示されるようになっています。 これに加え、「ログイン者が一定以上の役職（管理職）であれば同じ部署全員のシートを表示する（他部署は見れない）」構文を追加したいです。 Option Explicit Enum eColIndex id = 1 pass = 2 name = 3 dep = 4 post = 5 depcode = 6 postcode = 7 End Enum Private Sub Loginbtn_Click() Dim isAdmin As Boolean Dim isManage As Boolean Dim ws As Worksheet id = txtId.Text pass = txtPass.Text 'IDを検索しパスワードと照合 Dim idRow As Long Dim nameRow As Long On Error GoTo failed idRow = WorksheetFunction.Match(id, login.Columns(eColIndex.id), 0) If pass = login.Cells(idRow, eColIndex.pass) Then MsgBox "『" & login.Cells(idRow, eColIndex.name) & "』" & "でログインしました", vbInformation, "成功" Unload Me '入力されたIDから名前と部署と役職を参照する name = login.Cells(idRow, eColIndex.name) '入力ID行の3列目（氏名）のセルを参照 depcode = login.Cells(idRow, eColIndex.depcode) '入力ID行の6列目（部署コード）のセルを参照 postcode = login.Cells(idRow, eColIndex.postcode) '入力ID行の7列目（役職コード）のセルを参照 '所属・役職を判断 If depcode = "_ADM" Then isAdmin = True '部門コードが_ADMならシステム管理者 If postcode >= "J-3" Then isManage = True '役職コードがJ-3以上なら管理職 If isAdmin Then 'システム管理者なら For Each ws In Worksheets '全てのシートを ws.Visible = True '表示 Next －－－－－－－－－－－－－－－－－－－－－－－ ここに上述のシート表示の構文を記述したい －－－－－－－－－－－－－－－－－－－－－－－ Else 'いずれでもないなら個別シートを表示 On Error Resume Next 'エラートラップ開始 Set ws = Sheets(name) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません" Application.Quit '終了 End End If ws.Visible = True 'ユーザーのシート表示 For Each ws In Worksheets '全てのシート If ws.name <> name Then ws.Visible = False 'シート名がユーザ名のシート以外Visible=False Next End If Application.Visible = True 'ブックを表示 Else failed: 'エラーになった場合 MsgBox "ログインに失敗しました", vbCritical, "失敗" End If End Sub 試行錯誤してみましたがさっぱりうまくいきません。 どうかよろしくお願いいたします。

  • VBA実行時のエラー

    下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。 このプログラムをシートから実行した所 エラー：400『既にフォームは表示されています。モーダルにできません。』 なるものが表示されてしまいます。 またコードを記述する所から実行しますと 実行時エラー：１００４『アプリケーション定義またはオブジェクト定義のエラー』 となってしまいます。 私の努力が足りないのは重々承知ですが、解決する事が出来ません。 皆様のお力を借りることが出来たらと思い投稿しました。 宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub

  • 実行時エラー13　型が一致しません。エラー2029

    エクセルです。 A1に「=a」と文字が入っていて、 #NAME? となります。 その状態でvbaで セルA1に「=a」が入っているのなら としたい為、 Sub test() If Cells(1, 1) = "=a" Then End If End Sub こうしたのですが、 実行時エラー13　型が一致しません。 になります。 ｖｂａ中断中に、Cells(1, 1)の部分にマウスカーソルを当ててみると エラー　2029　となっています。 If Cells(1, 1) = "=a" Then が無理なら、 If Cells(1, 1) = "#NAME?" Then なら行けるかな？と思いましたが、 全く同じエラーになります。 最終的に何がやりたいかと言うと、 Sub test() If Cells(1, 1) = "=a" Then Rows(1).delele End If End Sub のように、#NAME?の場合は、その行を削除したいです。

  • エクセル2007 参照セルの値が認識されない

    エクセル2007の環境で下記マクロを実行すると、 アクティブシートのセルA1に数字が入っている場合、Sheet1のセルA1に値を転記しても そのセルA1の値をVLOOKUP関数で参照できません。 マクロに問題があるためなのか何処に問題があるのか分からないので教えてください。 宜しくお願いいたします。 【sheet】は アクティブシートの3行目から1000行目までのA列のセルをクリックしたらセルA1に値を表示 その後、下記【モジュール】を使用し、 アクティブシートのセルA1が空白の場合、 A列の数値をSheet1のセルA1に転記し、アクティブシートのA列の数値が空白になるまで循環する。 Sheet1のセルA1の値をVLOOKUP関数で参照した内容を表示、印刷します。 ----------------------------------------------------------------- '【sheet】 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 + IsEmpty(.Value) Then Exit Sub If Application.Intersect(.Cells, Range("A3:A1000")) Is Nothing Then Exit Sub ActiveSheet.Cells(1, 1).Value = .Value End With End Sub ----------------------------------------------------------------- '【モジュール】 Sub TEST() Dim myBtn As Integer Dim myMsg As String, myTitle As String Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Long myMsg = "●●●" myTitle = "確　認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) If myBtn = vbYes Then Set WS1 = ActiveSheet Set WS2 = Sheet1 If WS1.Cells(1, 1).Value = "" Then With WS1 For i = 3 To 65536 If .Cells(i, 1).Value = "" Then Exit For WS2.Cells(1, 1).Value = .Cells(i, 1).Value WS2.Cells(1, 2).Value = ActiveSheet.Name 'WS2.PrintOut Copies:=1 Next i End With ElseIf WS1.Cells(1, 1).Value >= 1 Then WS2.Cells(1, 1).Value = WS1.Cells(1, 1).Value WS2.Cells(1, 2).Value = WS1.Name 'WS2.PrintOut Copies:=1 Else End If End If End Sub -----------------------------------------------------------------

  • ファイルオープン時のマクロが一部実行されない

    いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub

  • Excel 2007 マクロのIF構文について

    Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub

  • シート1の氏名をシート2に反映

    sheet1の氏名をsheet2の日付、記号（A,B,C）にマッチした位置に入力させたいのですが下記コードで他で試したのですがうまくいきません。どなたかコードが解る方よろしくお願いします。 Sub 入力() Dim i As Long, j As Long, k As Long, L As Long Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") i = wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)) j = wS2.Cells(3, Columns.Count).End(xlToLeft).Column Range(wS2.Cells(3, 2), wS2.Cells(i, j)).ClearContents On Error Resume Next For i = 2 To wS1.Cells(Rows.Count, 4).End(xlUp).Row If WorksheetFunction.CountA(wS1.Rows(i)) > 1 Then For j = 2 To wS1.Cells(i, Columns.Count).End(xlToLeft).Column If wS1.Cells(i, j) <> "" Then k = WorksheetFunction.Match(wS1.Cells(i, 4), wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)), False) L = WorksheetFunction.Match(wS1.Cells(5, j), wS2.Rows(3), False) wS2.Cells(k, L) = wS1.Cells(i, j) End If Next j End If Next i End Sub

  • エクセルのVBA、ループ処理について

    if文とループ処理をどう組み合わせればいいのかわかりません 以下のコードで、iの数をを増やしていく処理を行いたいのですが、エラーがでてしまいうまくいきません どのように書けばいいのでしょうか 教えてください For i = 2 To 11 If Cells("4,i") > 80 Then Cells("5,i").Value = "A" ElseIf Cells("4,i") > 70 Then Cells("5,i").Value = "B" ElseIf Cells("4,i") > 60 Then Cells("5,i").Value = "C" Else Cells("4,i").Value = "D" End If Next

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する