• 締切済み

アクセスにてテーブル内の重複チェックについて

下記の様なテーブル構成になっています。 大分類マスタ 大分類 長整数型 分類見出し 文字列 このテーブルにフォームから入力をさせているのですが重複チェックの時にvercheckのデータ形式が違いますと出てエラーが出ます。色々とデータ形式を変えたのですがうまくいきません。 どの様にすれば宜しいのでしょうか?ご教授頂きます様お願い致します。 尚、テーブルの数値を文字形式にすれば動作するのは分かっているのですが数値形式の場合の やり方を教えてください。 Dim str大分類 As String Dim str分類見出し As String Dim vercheck As Variant If IsNull(大分類) = False Then str大分類 = 大分類 vercheck = DLookup("大分類", "T大分類マスタ", "大分類='" & str大分類 & "'") If Not IsNull(vercheck) Then MsgBox ("同じ大分類番号があります") Exit Sub Cancel = True Else End If Else Exit Sub End If If IsNull(分類見出し) = False Then str分類見出し = 分類見出し vercheck = DLookup("分類見出し", "T大分類マスタ", "分類見出し='" & str分類見出し & "'") If Not IsNull(vercheck) Then MsgBox ("同じ分類見出しがあります") Exit Sub Cancel = True Else End If Else Exit Sub End If -------ここからフォームから直にテーブルに書いています。--------- Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = Application.CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "T大分類マスタ", cn, adOpenKeyset, adLockOptimistic rs.AddNew rs![大分類] = Forms!F大分類マスタ登録画面!大分類 rs![分類見出し] = Forms!F大分類マスタ登録画面!分類見出し rs.Update End Sub

みんなの回答

  • Siegrune
  • ベストアンサー率35% (316/895)
回答No.1

vercheck = DLookup("大分類", "T大分類マスタ", "大分類=" & str大分類 & "") ・・・数値を比較したければ、''でくくらない。 ってことを聞きたいのかなとおもいました。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • 重複チェック

    あるシートに値を入れた時、そのシートのA1:Z80の範囲内で重複する値が既存するかどうか調べたいです。 下記のコードを試すと、どの値を入れても既存すると帰ってきます。 入力した値自身を見つけて重複だと言っている気がするのですが、どのように対処すればいいのか教えてほしいです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myCell As Range For Each myCell In Sheets("居場所").Cells If Target.Value = myCell.Value Then MsgBox "この名前は既に存在しています。", vbOKOnly + vbExclamation Exit Sub If myCell.Address = "$Z$80" Then Exit Sub End If Next End Sub

  • アクセスvba if文の記述方法

    検索フォームを作成しました。 入力項目は「氏名」「カナ」で入力チェックをおこなっております。 (未入力)メッセージを表示「未入力です」 (入力有)結果一覧のフォームを表示 未入力チェックは正常に処理されておりメッセージが表示されます。 項目に値を入力した場合フォームが起動しません。 if文から外した場合は正常に実行されます。 この条件の場合if文でどのように記述したらよいのでしょうか。 宜しくお願いします。 Private Sub 検索_Click() Dim mct As Control Dim flg As Boolean flg = False For Each mct In Me.Controls  If mct.ControlType = acTextBox Then   If mct.Tag = "Check" Then    If Not IsNull(mct) Then     flg = True     Exit Sub    End If   End If  End If Next mct If flg = True Then  Dim str As String  str = "[氏名] Like ""*" & Me!氏名 & "*"" And [カナ] Like ""*" & Me!カナ & "*"""  DoCmd.OpenForm "結果一覧", , , str Else  MsgBox ("未入力です") End If End Sub

  • Access 重複しないメールをテーブルに取り込む

    参考サイトのサンプルをマネしながら少しだけ改造して、OutLookのメールをAccessのテーブル"tbl_mail"に取り込むVBAを書いてみました。 一度取り込んだメールは二度と取り込まない仕組みなのですが、実行してみると必ず1通だけ重複したメールを取り込んでしまいます。 対象フォルダは「個人用フォルダ」の中の「受信トレイ」の中の「集荷」です。 サンプルとして3通のメールを入れていますが、何度実行しても、 "新しいメールはありませんでした。"とはならずに、 "読込み1件・重複2件"となります。 最近ADOを勉強し始めたばかりで原因がさっぱりわかりません。 このサンプルに対する質問は検索してもほとんど見つけられませんでした。 よろしくお願いいたします。 Access2010(Win7)で作り、DBはUSBに保存して、Access2007(vista)でも使っています。 フォームのボタンで標準モジュールのFunction MailGetoを呼び出して実行しています。 Function MailGeto() On Error GoTo エラー Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim myNaSp As NameSpace Dim myFolder As MAPIFolder Dim mySecFolder As MAPIFolder Dim myThrFolder As MAPIFolder Dim myItem As MailItem Dim myindex As Long, x As Long, y As Long, i As Long, r As Long Dim MyCri As String Set cn = Application.CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "tbl_mail", cn, adOpenKeyset, adLockOptimistic Set myNaSp = GetNamespace("MAPI") Set myFolder = myNaSp.GetDefaultFolder(olFolderInbox) i = 0: r = 0 For x = 1 To myFolder.Folders.Count Set mySecFolder = myFolder.Folders(x) For myindex = 1 To mySecFolder.Items.Count Set myItem = mySecFolder.Items(myindex) '受信日時と件名をつなげた文字列を一意とする MyCri = myItem.ReceivedTime & myItem.Subject '条件…"tbl_mail"テーブルの"KEY"フールドの値と一致するもの rs.Find "KEY='" & MyCri & "'" If rs.EOF Then '検索条件と合致する物がない場合 rs.AddNew rs!Key.Value = MyCri rs.Fields("フォルダー").Value = mySecFolder rs.Fields("受信日").Value = myItem.ReceivedTime rs.Fields("送信者").Value = myItem.SenderName rs.Fields("件名").Value = myItem.Subject rs.Fields("メール").Value = myItem.SenderEmailAddress rs.Fields("内容").Value = myItem.Body rs.Update i = i + 1 'メール件数を求めます。 Else r = r + 1 End If Next Next If i = 0 Then MsgBox "新しいメールはありませんでした。" Else MsgBox "メールの更新が完了しました。" & Chr(13) & Chr(13) & _ "・読込み " & i & "件" & Chr(13) & _ "・重複 " & r & "件" End If rs.Close cn.Close Exit Function エラー: If Err.Number = 287 Then MsgBox "書き出しを中止しました" Else MsgBox Err.Number & Err.Description MsgBox "予期せぬエラーが発生しました" End If End Function

  • vbaの繰り返し処理について

    vbaです。 Sub Test1() Dim Str As String Dim Pnt1 As Long Dim Pnt2 As Long Str = Range("A1") Pnt1 = InStr(Str, "重 http://") If Pnt1 <= 0 Then Exit Sub Pnt2 = InStr(Pnt1, Str, "要") If Pnt2 <= 0 Then Range("B1") = Mid(Str, Pnt1 + 2) Else Range("B1") = Mid(Str, Pnt1 + 2, Pnt2 - (Pnt1 + 2)) End If End Sub という式でA1からA2.A3と下にURLが入っており空欄になるまで同じ処理をしたいのですがどのように変更すれば作動しますでしょうか?

  • 2010 excel マクロ 記号の変化

    エラー発生で強制終了になってしまいます。2007年のexcelで作成したものですが、2010だと強制終了になってしまいます。 内容は□をダブルクリックすると■になるように作っています。 記述は2003年からのマクロ記述なので、変化が必要なのでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルをダブルクリックすると、・→○→△→×→・と変更する。 Dim S1 As String Dim S2 As String Dim S01 As String Dim S02 As String Dim S03 As String Dim S04 As String S1 = "□" S2 = "■" S01 = "・" S02 = "○" S03 = "△" S04 = "×" On Error GoTo ERR_12 sCheckXY S1, S2 sCheckX1234 S01, S02, S03, S04 sChangeXY S1, S2 Exit Sub ERR_12: End End Sub Sub sChangeXY(X As String, Y As String) '選択セルに□があれば■に変える Dim Str0 As String 'str1の左端 Dim Str1 As String 'strの右側更新 Dim Str2 As String 'strの左側更新 Dim Str20 As String 'strの左側一部保存 Dim L As Long Dim M As Long Dim N As Long Str1 = ActiveCell.Text L = Len(Str1) Debug.Print L If L = 0 Then End End If For N = 1 To L Debug.Print Str2 Str0 = Left(Str1, 1) If Str0 = X Or N = L Then If Str20 <> "" Then If N = L Then Str20 = Str20 + Str0 End If If MsgBox(Str20 & "  はチェックしますか?", vbYesNo, "選択肢") = vbYes Then Str2 = Str2 + Replace(Str20, X, Y) Str20 = Str0 Else Str2 = Str2 + Replace(Str20, Y, X) Str20 = Str0 End If Else Str20 = Str0 End If Else Str20 = Str20 + Str0 End If Str1 = Right(Str1, L - N) Next N ActiveCell.Value = Str2 End Sub Sub sCheckXY(X As String, Y As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X Then ActiveCell.Value = Y End ElseIf ActiveCell.Text = Y Then ActiveCell.Value = X End End If End Sub Sub sCheckX1234(X1 As String, X2 As String, X3 As String, X4 As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X1 Then ActiveCell.Value = X2 End ElseIf ActiveCell.Text = X2 Then ActiveCell.Value = X3 End ElseIf ActiveCell.Text = X3 Then ActiveCell.Value = X4 End ElseIf ActiveCell.Text = X4 Then ActiveCell.Value = X1 End End If End Sub

  • Access VBA

    Access2003を使用しています。 単純な質問かもしれませんがよろしくお願いします。 ログイン画面を作成しておりログイン自体はできたのですが、ログインしたときに ログイン画面を自動的に閉じたいのですが、うまくいきません。 現在の仕様では、ログイン画面(frm_ログイン)とメイン画面(frm_main)があり ログインに成功するとメイン画面が開くようになっています。 ーー以下VBAコードーー Private Sub rogin_Click() Dim a If IsNull(Me.[UserName]) Then MsgBox "IDが未入力です" Me.[UserName].SetFocus ElseIf IsNull(Me.[password]) Then MsgBox "パスワードが未入力です" Me.[password].SetFocus Else a = DLookup("パスワード", "tbl_ユーザー", "ユーザー名='" & Me.[UserName] & "'") If IsNull(a) Then MsgBox "該当する ユーザー名 は存在しません" Me.[UserName].SetFocus ElseIf StrComp(a, Me.[password], vbBinaryCompare) = 0 Then On Error GoTo Err_rogin_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_main" DoCmd.OpenForm stDocName, , , stLinkCriteria Else MsgBox "パスワードが違います" Me.[password].SetFocus End If End If Exit_rogin_Click: Exit Sub Err_rogin_Click: MsgBox Err.Description Resume Exit_rogin_Click End Sub ーー以上ーー 長くなって申し訳ないのですが、どのようにすればログイン後にログイン画面(frm_ログイン)を閉じるようにできるのでしょうか? よろしくお願いします。

  • Access VBA フィールドの追加とデータ

    こんにちは。 Access2003のVBAで質問です。 やりたいことは、指定フォルダにある「名簿.csv」をインポートし、テーブルの先頭に、フィールド[Unique_ID]を追加して、値に(フィールド[姓]&フィールド[名])をセットしたいのです。 インポートして、姓が空白のときは、レコードを削除することで、[Unique_ID]にnullがはいらないということはできましたが、肝心なフィールドの追加とレコードの追加がわかりません。 どのような方法があるでしょうか? ご教授よろしくお願いします。 Dim fpass As String Dim Dlfile As String Dim Fd As FileDialog Dim Fchk As String Dlfile = MsgBox("マスタデータを更新しますか?", vbOKCancel + vbExclamation + vbDefaultButton2) If Dlfile = vbCancel Then GoTo Exit_DT_UP_Click Const msoFileDialogFolderPicker = 4 Set Fd = Application.FileDialog(msoFileDialogFolderPicker) With Fd .Title = "更新データのフォルダを指定してください。" .AllowMultiSelect = False If .Show = False Then GoTo CkErr_DT_UP_Click fpass = .selecteditems(1) End With Dlfile = fpass & "\名簿.csv" Fchk = Dir(Dlfile, vbNormal) If (Fchk = "") Then GoTo CkErr_DT_UP_Click DoCmd.TransferText acImportDelim, "", "名簿", Dlfile, True, "", 65001 'ADO Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.Open "名簿", cn, adOpenKeyset, adLockOptimistic Do Until rs.EOF If IsNull(InStr(rs!姓, "")) Then rs.Delete Else 'レコード追加? End If rs.MoveNext Loop rs.Close Set rs = Nothing Set cn = Nothing CkErr_DT_UP_Click: Set Fd = Nothing Exit_DT_UP_Click: Exit Sub

  • またまた エクセルのユーザー定義で

    前回以下のようなコードを教えていただきましたが、この変換を複数列で使えるようにするにはどうしたらいいのでしょうか? D,G,N,Q,X,AA,の列に効かせたいのですが。 Private Sub worksheet_change(ByVal Target As Range) If Intersect(Target, Columns(1)) Is Nothing Or Selection.Count <> 1 Then Exit Sub Dim str As String str = Target Application.EnableEvents = False If Target <> "" Then If Len(str) = 7 Then Target = Left(str, 5) & "A" & Mid(str, 6, 1) & "-" & Right(str, 1) Else Target = Left(str, 5) & "A" & Mid(str, 6, 2) & "-" & Right(str, 1) End If End If Application.EnableEvents = True End Sub

  • ACCESS重複のチェック

    ACCESSで重複チェックをしたいと思います。 現在は電話番号テーブルだけしかありません。 電話番号のテーブルを主キーを使って重複している場合エラーメッセージを出すというものです。保存ボタンもありません。 Private Sub text電話番号_BeforeUpdate(Cancel As Integer) If IsNumeric(text電話番号) = False Then '数字チェック。 MsgBox "電話番号は数字で入力して下さい。", vbCritical Cancel = True ' 処理を取り消します。 Me.Undo End If Dim strmsg As String strmsg = "重複しています" If Not IsNull(DLookup("[電話番号]", "ダブリチェックテーブル", "[電話番号] = [text電話番号]")) Then MsgBox strmsg, 16, "ダブリチェック" Cancel = True '処理を取り消します。 Me.Undo '元に戻します。 Else Cancel = False '処理を続行します。 End If End Sub これに、企業名と出発日という項目を増やしたいと思います。 ですが、何万とある電話番号を一気に入力して調べているので、一回一回企業名と出発日を入れていると生産性が落ちます。 ですので、企業名と出発日は最初の入力だけで次のレコードに移動してを継続させたいのです。そして電話番号以外にカーソルを行かないようにしたいです。 何か良い方法があればご教授お願いします。 ちなみにいろいろ自分なりに試したのですが、重複してエラーを出した場合に企業名にカーソルが飛んだししてうまくいきませんでした。

  • Accessフォームの作成

    Accessで作成されているシステムの ファイル取り込みフォームにある実行ボタンを押下すると、 下記のメッセージが表示されます。 「select case に対応する case がみつからない。」 どこかで指定しないといけないのでしょうか? Private Sub Cmd実行_Click() On Error GoTo Err Dim StrSql As String Dim IntNDCnt As Integer Dim IntNTCnt As Integer '確認メッセージの出力 If MsgBox("処理を開始します。よろしいですか?", vbInformation + vbYesNo, "データ取込処理") = vbNo Then Exit Sub End If '対象データ別の処理実行 Select Case Me.Cmb対象.ListIndex Case -1 'エラー MsgBox "読込むデータを指定してください", vbCritical, "データ取込処理" Exit Sub Case 0 '全データ If F_手数料明細読込() = False Then Exit Sub End If If F_奨励金読込() = False Then Exit Sub End If If F_減額読込() = False Then Exit Sub End If If F_預り金読込() = False Then Exit Sub End If Case 1 '手数料データ If F_手数料明細読込() = False Then Exit Sub End If Case 2 '奨励金データ If F_奨励金読込() = False Then Exit Sub End If Case 3 '減額データ If F_減額読込() = False Then Exit Sub Case 4 '預り金データ If F_預り金読込() = False Then Exit Sub End If End Select 今は、Case 4が黄色に反転します。