社員番号から検索するマクロが作動しなくなった理由と解決方法
- 社員番号から検索するマクロを利用する際に、各自宅の電話番号である10桁の数字から検索しようとした場合、マクロが動作しなくなります。
- この問題を解決するためには、社員テーブルのカラムを修正し、各自宅の電話番号を格納するカラムを用意する必要があります。
- その後、マクロの処理部分を変更し、新たに作成したカラムを参照するように修正することで、各自宅の電話番号からの検索が可能となります。
- ベストアンサー
番号検索
社員テーブルの4桁で構成される社員番号から検索するマクロを下記にて組みました。しかし、4桁の社員番号からではなく各自宅電話番号の10桁の数字から検索するために社員番号を各自宅の電話番号10桁の番号に変え入力フォームのC4のセルに10桁の数値を入れて検索したところマクロが作動しなくなりました。ご教示願います Sub ボタン1_Click() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Worksheets("入力フォーム").Range("C4").Value motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11") Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当する事案はありません" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub
- hahalu0589
- お礼率70% (7/10)
- その他(データベース)
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
電話番号が記録されているということは、 そのセルは数値型ではなく、文字型ではないでしょうか？ Dim tmpInt As Integer の宣言で、tmpIntは数値として扱われるので、 文字型のフィールドとは一致しないことになります。 Dim tmpInt As String に変更してみれば、どうでしょうか？
関連するQ&A
- データ検索後の上書き
データシートに記載がある社員番号を入力フォームに入力し特定の社員データを検索するマクロを下記にて組みました。検索抽出された社員データを直接一部修正入力してもとの社員データヘ上書き処理をする(データによって修正しないこともあり)場合のマクロをご教示願います。 Sub ボタン1_Click() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Worksheets("入力フォーム").Range("C4").Value motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11") Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当する事案はありません" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub
- ベストアンサー
- その他(データベース)
- 検索して修正したデータの上書転記
Sub 検索() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Sheets("入力フォーム").Range("C4").Value motoHani = Array("C10", "C12", "C13") Set myRng = Range("テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当するレコードはありませんでした" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub 入力シートと一覧表シートを作成し入力シートの入力フォームにデータを入れてマクロを実行すると一覧表シートにレコード転記されるようにしました。 一覧表シートに転記したデータを,検索し入力フォーム上に表示させることはできたのですが、データを修正して一覧表シートに更新（上書転記）させる方法がわかりません。どうかご存知の方、教えてください。
- ベストアンサー
- Visual Basic
- VBAで検索後、行番号取得し上書き保存
Excel2002です。入力シートと一覧シートを作成し、入力シートの入力フォームに入力すると一覧シートの表の最終行に新規で転記されるようにしました。 また、入力シートでカタカナ検索すると、入力フォームに表示され、そのデータがある行番号をA1セルに取得するまではできました。検索表示したデータを修正し、取得した行番号に上書きしたいのですが、どうしても2行下に上書きされてしまいます。 取得行番号 980 → 上書きされる行番号 982 そのまま980行にデータを上書きしたい場合、どうしたらいいのでしょうか？ 困っています。よろしくお願い致します。 -------------------------------------------------------------- Sub 新規レコード転記2() Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long Dim lastRec As Range, newRec As Range Dim motoHani() Application.ScreenUpdating = False '画面の更新をストップ Set sakiSht = Sheets("一覧") motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16") Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1) For i = 0 To UBound(motoHani) sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value motoSht.Range(motoHani(i)).MergeArea.ClearContents Next MsgBox "入力を完了しました。" End Sub Sub 情報検索() Dim tmpInt As String, motoHani(), myRng As Range, i As Integer '変数の宣言 tmpInt = Sheets("入力").Range("D4").Value '検索する文字列を取得 motoHani = Array("C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16") '転記する位置を設定 Set myRng = Range("顧客情報").Columns(1).Find(tmpInt, LookAt:=xlWhole) '顧客情報の1フィールド目を対象に検索 If myRng Is Nothing Then MsgBox "該当するレコードはありませんでした" Exit Sub End If '検索値が無かった場合は処理を抜ける For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next '検索値が見つかったセルを元にレコードの情報を転記 '検索した行番号をA1セルに保存 Range("A1") = myRng.Row End Sub Sub 修正して上書き() Dim no As Long, motoHani(), i As Integer no = Range("A1") motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16") For i = 0 To UBound(motoHani) Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value Next MsgBox "修正しました。" End Sub ---------------------------------------------------------------
- ベストアンサー
- オフィス系ソフト
- 入力用シートから文字検索し、データシートから情報を呼び出す
入力用シートから蓄積用シートにデータを転記し、同じ入力シートを使って蓄積用シートからデータを呼び出して修正できるようにしたいと考えています（入力ボタン・呼び出しボタンあり）。転記はできたのですが、呼び出しが出来ません。本を見て作業していますが、私は文字で検索したいのです。本では数字（社員コード）で検索しています。 Sub セル範囲に名前を付ける() Dim myName As String, myrng As Range myName = "顧客情報" Set myrng = Worksheets("一覧").Range("B3:T65536") ThisWorkbook.Names.Add myName, myrng End Sub Sub 新規レコード転記2() Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long Dim lastRec As Range, newRec As Range Dim motohani() Application.ScreenUpdating = False '画面の更新をストップ Set motoSht = Sheets("入力") Set sakiSht = Sheets("一覧") motohani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C13", "E13", "H13", "J13", "C14", "C15", "C16") Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1) For i = 0 To UBound(motohani) sakiRng.Offset(0, i).Value = motoSht.Range(motohani(i)).Value motoSht.Range(motohani(i)).MergeArea.ClearContents Next MsgBox "入力を完了しました。" End Sub ここまでは動作OKでした。問題はこの下です。検索セルに数字を入れると動作するのですが、私は名前（全角カタカナ）で検索したいのです。 Sub 情報検索() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer '変数の宣言 tmpInt = Sheets("入力").Range("D4").Value '検索する値を取得 motoHani = Array("C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C13", "E13", "H13", "J13", "C14", "C15", "C16") '転記する位置を設定 Set myRng = Range("顧客情報").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当するレコードはありませんでした" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub 宜しくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- Excel UserForm ListBox
Excel UserForm ListBoxの表示についての質問です Sheets("加工").Range("A44")からRange("G" & LastRow)のセルの値を Form_receipt.ListBox1に表示させたいのですが C～E列は数値なので桁数区切りで表示したくてマクロを作ったのですが Ａ列１列しか表示されないマクロになってしまいました。 どこが悪いのかご教示願えませんか？ あわせてC～E列を右揃えでリスト表示する方法も教えてください 失敗作のマクロは以下です Sub Macro48() Form_receipt.ListBox1.Clear Sheets("加工").Select '配列の定義 Dim myRng As Range Dim myList As Variant Dim c As Variant Dim i As Integer Dim j As Integer Dim LastRow As Integer For j = 45 To 94 If Sheets("加工").Range("A" & j).Value = "" Then Exit For End If Next j If Sheets("加工").Range("A47").Value = "" Then LastRow = j - 1 Else LastRow = 46 End If Set myRng = Range("A44", Range("A" & LastRow)) ReDim myList(myRng.Rows.Count - 1, 7) For Each c In myRng myList(i, 0) = c.Offset(, 0).Value myList(i, 1) = c.Offset(, 1).Value myList(i, 2) = Format$(c.Offset(, 2).Value, "@@@,@@@,@@@") myList(i, 3) = Format$(c.Offset(, 3).Value, "@@@,@@@,@@@") myList(i, 4) = Format$(c.Offset(, 4).Value, "@@@,@@@,@@@") myList(i, 5) = c.Offset(, 5).Value myList(i, 6) = c.Offset(, 6).Value myList(i, 7) = c.Offset(, 7).Value i = i + 1 Next c Form_receipt.ListBox1.List() = myList Set myRng = Nothing 'リスト表示幅設定 With Form_receipt.ListBox1 .ColumnWidths = "30,0,60,60,60,150,50" End With Form_receipt.Show End sub
- ベストアンサー
- オフィス系ソフト
- 異なるBookからの検索
VBA初心者です。 集計.exl 野菜.exl 果物.exlとファイルがあり、野菜と果物にはシートが３枚づつあります。 集計ファイルのセルを野菜と果物ファイルから検索したいのです。 本等を見て調べたのですが、異なるBookからの検索方法が見つかりません。 Private Sub kensaku() Dim i As Integer Dim myFLd As Range, myRng As Range ' i = Cells("3,2").Select Workbooks.Open ("C:\果物.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) If myRng Is Nothing Then Workbooks.Open ("野菜.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) Exit Sub End If If myRng Is Nothing Then MsgBox "ありません" Exit Sub End If MsgBox "対象" & myRng.Address End Sub としたのですが、 Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) 部分のエラー(whitがありません）とでて、直りません。 あと、このやり方であっているのでしょうか? アドバイスお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel 2007 <VBAでグラフの操作>
Excel 2007 <VBAでグラフの操作> 現在すでにあるグラフを修正しています。 下記マクロでは「各グラフに系列が2つあり、その1つ目を削除して残る1つのデータ範囲（X軸の値)を再設定する」という内容です。 下記マクロではFor構文冒頭のSet～の行で、 「実行時エラー '1004'： 'Cells'メソッドは失敗しました:'_Global'オブジェクト」 とのエラーが出ます。 このエラーについて検索してみたのですが、これといったものが見つからなかったので、このマクロでおかしなところがあれば直接指摘していただけないでしょうか。 よろしくお願いします。 Private Sub Test_Arrange() Dim MyRng As Range Dim R As Integer Dim n As Integer Dim i As Integer n = 10 R = Sheets("Sheet1").Range("A1").End(xlDown).Row For i = 1 To n Set MyRng = Sheets("Sheet1").Range(Cells(2, 2 * n + 3), Cells(R, 2 * n + 3)) Charts(i).SeriesCollection(1).Delete Charts(i).SeriesCollection(1).XValues = MyRng Next i End Sub
- ベストアンサー
- その他MS Office製品
- VBAでオートフィルを使って指定する文字列を含むものを表示させたい
VBAを使って、セルD1に入力した文字列を検索するマクロを作りたいと思っています。 私は初心者で前に似たようなものを作ってもらって それを加工しようとしたのですが、うまくいきませんでした。 以前は完全に一致するもので表示でしたが、 今回は含むものを表示させたいです。 ワイルドカードは＊をつけるのはわかるのですが、 いろいろやってみましたがダメでした。（単純なことかもしれないですけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng1 As Range Dim myRng2 As Range Set myRng1 = Target.Cells(1) If Application.Intersect(myRng1, Range("D1")) Is Nothing Then Exit Sub Set myRng2 = Range("D1").CurrentRegion With myRng2 If myRng1 = "" Then ActiveSheet.ShowAllData Else .AutoFilter Field:=4, Criteria1:=myRng1.Value End If End With End Sub
- 締切済み
- その他（プログラミング・開発）
- マクロでの次の実行マクロへの記述
下記のマクロを記述しました。 一つのマクロ処理を終わらせて、次のマクロ（例：test）を動かしたいのですが何処に 記述したら良いかわかりません。 教えてください。 Sub Macro1() Dim i As Integer Dim buff As String i = 2 While 1 If Range("B" & i).Value = "" Then End End If buff = Range("B" & i).Value Range("B" & i).Value = Left(buff, 7) + " " + Mid(buff, 8, 5) + " " + Right(buff, 6) i = i + 1 Wend Call test →ここに仮に記述したのですが、testのマクロに行きません。 End Sub 以上
- ベストアンサー
- オフィス系ソフト
- データ検索ネスト Excel VBA
excel2003でデータ検索の処理をするというマクロをVBAで作成したいのですが、うまく動作しません。自作のVBAを記載してみましたので何が原因なのか教えてください。初心者です、よろしくお願いします。 Sub データ検索() Dim i As Integer, j As Integer, k As Integer, l As Integer Dim myRange As Range Dim IngLastrow As Long IngLastrow = Range("A65536").End(xlUp).Row For i = 3 To IngLastrow For j = 3 To 25 For k = 8 To 53 For l = 3 To 9 Set myRange = Worksheets("データベース").Cells(i, "o").Find(what:=Worksheets("コード").Cells(j, "o").Value, _ LookIn:=xlValues) If Not myRange Is Nothing Then Worksheets("予定").Cells(k, l).Value = myRange.Offset(, -12).Value End If Next l Next k Next j Next i End Sub
- ベストアンサー
- オフィス系ソフト
お礼
宣言をご指摘の表記にしたら作動しました。大変助かりありがとうございました。Integerの認識を改めます。