先日質問がうまくできていなかったので再度投稿します。
何度も申し訳ございません。
やりたいことはExcelからデータを読み取り、SQLへ流し込むためのCSVを作成するにあたり
いったんExcelに読込エラーチェックをします。
先日も書きましたが、半角英数字のチェックは職員コードになります。
その際に半角英数字以外の文字が入っていたら、セルに色を付けるという風にしたいです。
どうも、半角英数字のチェックがうまくいってないようです。
郵便番号のチェック~~はできてます。~~もできてませんでした。
データが文字列だからなのかと思っていたのですが、そうではないようでした。
意図的に文字列から数値に変換してもすべてセルの色が赤になってしまいました。
ご教示よろしくお願いします。
VBA
1Private Sub ErrCheck() 2 3 Dim i As Long 4 Dim r As Long 5 Dim c As Long 6 Dim Err As Boolean 7 Dim reg As New RegExp 8 Dim reg2 As New RegExp 9 10 r = Me.Cells(Me.Rows.Count, 3).End(xlUp).Row 11 Err = False 12 13' reg.Pattern = "^[a-zA-Z0-9!-/:-@[-`{-~]+$" '半角英数字のチェック用 14 reg.Pattern = "^[0-9A-Za-z]+$" 15 reg.Global = True 16 reg.Pattern = "^[0-9]{3}-[0-9]{4}$" '郵便番号チェック 17 reg2.Global = True 18 19 Select Case Cells(8, 3).Value 20 Case "職員マスタ" 21 22 23 For i = 14 To r 24 '必須項目チェック 25 For c = 3 To 5 26 If Me.Cells(i, c) = "" Then 27 Me.Cells(i, c).Interior.Color = RGB(255, 0, 0) 28 Err = True 29 End If 30 Next 31 32 If Len(Me.Cells(i, 4).Value) > 16 Then 33 Me.Cells(i, 4).Interior.Color = RGB(255, 0, 0) 34 ElseIf Len(Me.Cells(i, 5).Value) > 16 Then 35 Me.Cells(i, 5).Value.Interior.Color = RGB(255, 0, 0) 36 ElseIf Len(Me.Cells(i, 9).Value) > 16 Then 37 Me.Cells(i, 9).Value.Interior.Color = RGB(255, 0, 0) 38 ElseIf Len(Me.Cells(i, 10).Value) > 16 Then 39 Me.Cells(i, 10).Value.Interior.Color = RGB(255, 0, 0) 40 ElseIf Len(Me.Cells(i, 11).Value) > 16 Then 41 Me.Cells(i, 11).Value.Interior.Color = RGB(255, 0, 0) 42 End If 43 44 '重複チェック 45 If WorksheetFunction.CountIf(Range(Cells(14, 3), Cells(r, 3)), Cells(i, 3)) > 1 Then 46 Me.Cells(i, 3).Interior.Color = RGB(255, 0, 0) 47 Err = True 48 End If 49 50 '半角英数字チェック 51 If reg.test(Cells(i, 3).Value) = False Then 52 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 53 Err = True 54 ElseIf Len(Cells(i, 3)) > 10 Then 55 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 56 Err = True 57 End If 58 '郵便番号チェック 59 If Cells(i, 8) <> "" Then 60 If reg2.test(Cells(i, 8).Value) = False Then 61 Cells(i, 8).Interior.Color = RGB(255, 0, 0) 62 Err = True 63 End If 64 End If 65 Next 66 67 68 Case "受講ファイル(本部一括)" 69 70 For i = 14 To r 71 For c = 3 To 5 72 If Me.Cells(i, c) = "" Then 73 Me.Cells(i, c).Interior.Color = RGB(255, 0, 0) 74 Err = True 75 End If 76 Next 77 If Me.Cells(i, 3) = 16 And Me.Cells(i, 5) = 1 Then 78 Me.Cells(i, 5).Interior.Color = RGB(255, 0, 0) 79 Err = True 80 ElseIf Me.Cells(i, 3) = 27 And Me.Cells(i, 5) = 2 Then 81 Me.Cells(i, 5).Interior.Color = RGB(255, 0, 0) 82 Err = True 83 ElseIf Me.Cells(i, 3) = 28 And Me.Cells(i, 5) = 2 Then 84 Me.Cells(i, 5).Interior.Color = RGB(255, 0, 0) 85 Err = True 86 End If 87 88 Next 89 Case "受講ファイル(個別一括)" 90 For i = 14 To r 91 For c = 3 To 7 92 If Me.Cells(i, c) = "" Then 93 Me.Cells(i, c).Interior.Color = RGB(255, 0, 0) 94 Err = True 95 End If 96 Next 97 98 If Me.Cells(i, 5) = 16 And Me.Cells(i, 6) <> 2 Then 99 Me.Cells(i, 3).Interior.Color = RGB(255, 0, 0) 100 Err = True 101 ElseIf Me.Cells(i, 3) = 27 And Me.Cells(i, 4) <> 2 Then 102 Me.Cells(i, 3).Interior.Color = RGB(255, 0, 0) 103 Err = True 104 End If 105 106 '送付先が1でも2でもない場合 107 If Me.Cells(i, 7).Value <> 1 And Me.Cells(i, 7).Value <> 2 Then 108 Me.Cells(i, 7).Interior.Color = RGB(255, 0, 0) 109 End If 110 111 112 '半角英数字チェック 113 If reg.test(Cells(i, 3).Value) = False Then 114 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 115 Err = True 116 ElseIf Len(Cells(i, 3)) > 8 Then 117 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 118 Err = True 119 ElseIf reg.test(Cells(i, 4).Value) = False Then 120 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 121 Err = True 122 ElseIf Len(Cells(i, 3)) > 10 Then 123 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 124 Err = True 125 End If 126 127 Next 128 Case "受講ファイル(金融法務講座)" 129 For i = 14 To r 130 If Me.Cells(i, 3) = "" Then 131 Me.Cells(i, 3).Interior.Color = RGB(255, 0, 0) 132 Err = True 133 End If 134 135 '重複チェック 136 If WorksheetFunction.CountIf(Range(Cells(14, 3), Cells(r, 3)), Cells(i, 3)) > 1 Then 137 Me.Cells(i, 3).Interior.Color = RGB(255, 0, 0) 138 Err = True 139 End If 140 '半角英数字チェック 141 If reg.test(Cells(i, 3).Value) = False Then 142 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 143 Err = True 144 ElseIf Len(Cells(i, 3)) > 10 Then 145 Cells(i, 3).Interior.Color = RGB(255, 0, 0) 146 Err = True 147 End If 148 Next 149 End Select 150 151 If Err = True Then 152 MsgBox "エラーがあります。" & vbCrLf & "必須項目または赤いセルを確認して下さい" 153 End If 154 155End Sub 156 157 158
回答3件
あなたの回答
tips
プレビュー