S41(S41:AI47)のセルに下記のような丸文字があります。
(↓文字化けしてました)
(1)❷ (3)(4)(5)(6)(7)❽ (9)
以後、()は○だと思ってください。❷は黒丸2 ❽は黒丸8 です。
やりたい事:
1)
このS41のセル内の重複チェックしたい。(AK41 辺りに重複 の表示)
只、(2)❷など白丸文字と黒丸文字 は同じ値とし、チェックしたい(例 (2)❷ =重複)
(この丸文字は単語登録してありますので、➀(1)といった類似文字を間違って入力する事はないと思います。)
2)
(1)~(9)の数値が全部入力されているかの確認をしたい。
1)に関しては安易な考えなのですが可能なのであれば、(そもそもこのようなマクロは無いかもしれませんが)(1)=1 (2)=2 ❷=2と置き換えてAL41のセルに入力できるようにし、AL41を重複チェックしたら良いのか?など思っています。
優先的には、1)を重視したいです。
エクセル2003を使用しています。
(2007でないとできないというのであれば 何とか成功させたいので2007導入も検討します)
環境依存文字で難しいのかもしれませんがよろしくお願いします。
A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
#4 のユーザー定義関数に関して
Public Function CheckDoubles(ByVal rng As Range, Optional opt As Integer = 0) As
~
End Functon
同じブックの、標準モジュールに貼り付けます
'-------------------------------------------
シートの必要な場所に
= CheckDoubles(セルまたはセルの範囲)
例:
=CheckDoubles(S41)
足りない数値が出ます。
= CheckDoubles(セルまたはセルの範囲, 1 ) Opt は、0以外です。
ダブリの数字が出ます。
例:
=CheckDoubles(S41,1)
'-------------------------------------------
たったこれだけのことです。ヘルプは、現在の設定では出てきません。
なお、数式は、あまり多く使いますと、配列数式と同様、シートが重くなりますから、マクロで、定数化したほうが軽くなります。
No.5
- 回答日時:
#3です。
>実際にはスペースがあります。
よく見ると質問文の例にもちゃんとスペースが入ってますね^^;;
見落としていました、すみません。
#4さまがユーザー定義関数を提示されていますので、
もう不要かもしれませんが…。
-------------------------------------
作業セルをもう一つ用意し、対象セルに対してまず、
=SUBSTITUTE(ASC(A1)," ",)
とすれば、(全半角問わず)スペースを除いた文字列が得られますから、
そのセルについて、#3と同様に変換,チェックをおこなえば結果が得られます。
1.対象セル
↓
2.スペース除去
↓
3.変換
↓
4-1.重複チェック
4-2.欠落チェック
という順です。
一応ご参考まで。
度々、ありがとうございます。
できました!感激です。
エクセルって本当に奥が深くすごいんですね。
(皆様の様に使いこなせればですけど・・・)
#1の回答者様の方法と併用で使っていきたいと思います。
No.4
- 回答日時:
こんにちは。
ユーザー定義関数に換えてみました。あくまでも、VBAをご存知の方に対するものですから、こちらから、あまり初歩的な説明をするつもりはありません。組み込んでお使いになれるようなら、お試しください。組み込み関数では出来ないことが可能かと思います。
ユーザー定義関数の数式は、
不足している数字
=CheckDoubles(A1:J1)
重複している数字
=CheckDoubles(A1:J1, 1)
単独セルでも、複数セルでも検索可能です。
重複がない場合は、空文字「""」が出力しています。
なお、
'パターン
mPattern = "\u2460-\u2468\u2776-\u277E"
文字範囲は、Unicode になっていますから、その範囲を指定すればよいのですが、
If n > 10 ^ 4 Then n = n - 10101
If n > 9 * 10 ^ 3 Then n = n - 9311
ここで、数値に変換しています。ただし、配列は、数字(文字)に変換しています。
'-------------------------------------------
'標準モジュール
'-------------------------------------------
Public Function CheckDoubles(ByVal rng As Range, Optional opt As Integer = 0) As String
Dim buf() As Variant
Dim misbuf() As Variant
Dim dbuf() As Variant
Dim dbbuf() As Variant
Dim n As Variant
Dim s As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim c As Variant
Dim v As Variant
Dim ret As Variant
Dim Matches As Object
Dim Match As Object
Dim mPattern As String
Dim List1 As Variant
Dim List2 As Variant
'パターン
mPattern = "\u2460-\u2468\u2776-\u277E"
If WorksheetFunction.CountA(rng) = 0 Then Exit Function
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = ".*[" & mPattern & "].*"
For Each c In rng
For k = 1 To Len(c.Value)
s = Mid$(c.Value, k, 1)
If .Test(s) Then
Set Matches = .Execute(s)
n = AscW(Matches(0).Value)
If n > 10 ^ 4 Then n = n - 10101
If n > 9 * 10 ^ 3 Then n = n - 9311
On Error Resume Next
ret = Application.Match(CStr(n), buf, 0)
On Error GoTo 0
If IsError(ret) Or IsEmpty(ret) Then
ReDim Preserve buf(i)
buf(i) = CStr(n)
i = i + 1
Else
ReDim Preserve dbuf(j)
dbuf(j) = CStr(n)
j = j + 1
End If
End If
Next k
Next c
'MissingList
j = 0
For i = 1 To 9
ret = Application.Match(CStr(i), buf, 0)
If Not IsNumeric(ret) Or IsEmpty(ret) Then
ReDim Preserve misbuf(j)
misbuf(j) = CStr(i)
j = j + 1
End If
Next i
'DoublingList
On Error Resume Next
ret = Empty
ret = LBound(dbuf)
On Error GoTo 0
j = 0
If Not IsEmpty(ret) Then
For Each v In dbuf
ret = Empty
On Error Resume Next
ret = Application.Match(CStr(v), dbbuf, 0)
On Error GoTo 0
If IsError(ret) Or IsEmpty(ret) Then
ReDim Preserve dbbuf(j)
dbbuf(j) = CStr(v)
j = j + 1
End If
Next v
End If
List1 = Join(misbuf, ",")
List2 = Join(dbbuf, ",")
If opt <> 0 Then opt = 1
CheckDoubles = Array(List1, List2)(opt)
End With
End Function
何度もありがとうございます。
色々試させてもらいましたが私では使いこなせませんでした。(ヘルプなど確認しましたがRng 、Opt など検索できませんでした)
(関数の挿入→CheckDoubles→ Rng と Opt 共にS41を指定してみたりしましたが駄目でした)
折角、素晴らしいものを提供してもらいましたが申し訳ありません。
最初に教えていただい方法ならわかりますので使っていきたいと思っています。そこでお願いがあるのですが、1~8など 9個なかった時(重複なし時)に、重複なし という表示のみで 不足している数が出ないことに気づきました。 お時間がある時かまいませんので、修正可能ならして頂けると助かります。
No.3
- 回答日時:
・複数の丸付数字が単一のセルに入っている
・数字は1~9までに限る
・黒丸付数字と白丸付数字は判定上区別しない
という解釈であってますか?
------------------------------
作業セルを使えば、数式でもなんとかなります。
以下、投稿の都合上、
・白丸数字の1~9を、あいうえおかきくけ
・黒丸数字の1~9を、アイウエオカキクケ
で代用して表記します。
------------------------------
●変換(作業セル)
対象セルがA1であるとして、
=TEXT(SUMPRODUCT(10^(INT(FIND(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1),"†あアいイうウえエおオかカきキくクけケ")/2)-1)),REPT("0",9))
とすると、9文字の数字列が表示されます。
下第N桁の数字は、丸付数字Nの個数を表します。
111111211 ⇒ 下第3桁が2 ⇒ 3が重複
111011111 ⇒ 下第6桁が0 ⇒ 6が欠落
------------------------------
●重複チェック
作業セルがB1であるとして、
=IF(MAX(INDEX(--MID(B1,ROW(INDIRECT("1:9")),1),))>1,"#重複!!","OK!")
とすれば、重複がある場合に、"#重複!!" と表示されます。
------------------------------
●欠落チェック
作業セルがB1であるとして、
=IF(ISERR(FIND("0",B1)),"OK!","#欠落!!")
とすれば、欠落がある場合に、"#欠落!!" と表示されます。
------------------------------
なお、
(6)(6)(6)(6)(6)(6)(6)(6)(6)(6)
のように、
【変換した数字列の桁が繰り上がってしまうほど】
多くの重複がある場合には
正しい結果が得られない可能性があります、念のため。
以上ご参考まで。
ありがとうございます。
解釈はそのとおりです。
只、質問の仕方が悪く実際にはスペースがあります。最初にスペースが必ずきまして途中にも2~4個、」合計3個~5個入ってきます
例) スあいスうえオカきスくケ
ス=全角スペース
(質問時にスペースあけてたつもりでしたが、前詰めされて表示されていました)
スペースなし状態ではバッチリでした。
それにしても数式のみでこんな表現ができるとは本当に凄いですね。私からすれば神の領域です。
No.2
- 回答日時:
#1の回答者です。
もともとは、ユーザー関数を想定したものですが、#1の回答で書いたとおり、ご質問の内容では、読み取れません。ただ、丸付き数字のダブりや不足を検出できるというところまでしか組み込ませんでした。
求めるものが、実際に具体的にはどういうものかも分かりません。単に、True, False だけでは足りそうもないようですし、かといって、あまり複雑なものでは、ユーザー定義関数で出力するのも難しくなります。
ですから、#1のマクロをモジュールに貼り付けたところで、コードをある程度分からない状態では、まったく動きません。
>S41(S41:AI47)のセルに下記のような丸文字があります。
>このS41のセル内の重複チェックしたい。(AK41 辺りに重複 の表示)
データが、S41:AI47までとしても、S41のセル内? AK41辺りに重複の表示?という表現では、一体にどこにどう出すのか、どのように理解していいのか、理解できません。
シートモジュール?すみませんが、良く分かりません。シートモジュールというのは、イベント・ドリブン型にするという意味でしょうか?シートモジュールでは、それ以外の使い道は、よほどの初心者でなければ、そこを使うことはありません。
なお、
Test1 の
Set rng = Range("A1:K1")
に範囲を入れると、ユーザー定義関数に渡されます。
ありがとうございます。
説明不足ですみません。
マクロは少し触れた程度の初心者です。標準モジュール=都度マクロ実行をしなければならないものだと思ってまして、シートモジュールならなにもしなくても実行させるのかと思ってました。
質問内容は
3番目の回答者様が書いてくれていました内容
・複数の丸付数字が単一のセルに入っている
・数字は1~9までに限る
・黒丸付数字と白丸付数字は判定上区別しない
後、S41:AI47は 結合してありS41になっているという意味でした。
素人の考えで AK41に重複などのエラーがありましたら表示できればと思っていました。
フォームボタンを作って都度実行してやってみます。
それにしても、皆さん頭が下がります。素晴らしいの一言です。
ありがとうございました。
No.1
- 回答日時:
こんばんは。
ご質問は読み取れませんでしたが、重複のチェックは可能です。
'-------------------------------------------
'標準モジュール
'-------------------------------------------
Sub Test1()
Dim i As Long
Dim j As Long
Dim msg As String
Dim msg2 As String
Dim rng As Range
Dim ret As Variant
Dim n As Variant
Dim List1 As Variant
Dim List2 As Variant
Set rng = Range("A1:K1")
ret = CheckDouble(rng, List1, List2)
On Error Resume Next
'ダミー
If List1(0) = 0 Then GoTo EndLine
On Error GoTo 0
For i = 1 To 9
n = Application.Match(i, List1, 0)
If IsError(n) Then
msg = msg & "," & i
End If
Next i
If ret = True Then
For j = 0 To UBound(List2)
msg2 = msg2 & "/" & List2(j)
Next j
End If
If msg = "" Then
msg = "1~9まであります。"
Else
msg = "足りない数字 " & Mid$(msg, 2)
End If
If msg2 = "" Then
msg = "重複はありません。"
Else
msg2 = "重複している数字 " & Mid$(msg2, 2)
End If
MsgBox msg & vbCrLf & msg2
EndLine:
Set rng = Nothing
End Sub
Function CheckDouble(ByVal rng As Range, ByRef List1 As Variant, ByRef List2 As Variant)
Dim buf() As Long
Dim dbuf() As Long
Dim n As Variant
Dim s As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim c As Variant
Dim ret As Variant
Dim Matches As Object
Dim Match As Object
Dim flg As Boolean
Dim mPattern As String
flg = False
mPattern = "\u2460-\u2468\u2776-\u277E"
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = ".*[" & mPattern & "].*"
For Each c In rng
For k = 1 To Len(c.Value)
s = Mid$(c.Value, k, 1)
If .Test(s) Then
Set Matches = .Execute(s)
n = AscW(Matches(0).Value)
If n > 10 ^ 4 Then n = n - 10101
If n > 9 * 10 ^ 3 Then n = n - 9311
On Error Resume Next
ret = Application.Match(n, buf, 0)
On Error GoTo 0
If IsError(ret) Or IsEmpty(ret) Then
ReDim Preserve buf(i)
buf(i) = n
i = i + 1
Else
ReDim Preserve dbuf(j)
dbuf(j) = n
j = j + 1
flg = True
End If
End If
Next k
Next c
List1 = buf
List2 = dbuf
CheckDouble = flg
End With
End Function
'-------------------------------------------
ありがとうございます。
色々試していますが、マクロ実行しても何も反応ありません。
どこのセルに値を入れたらよいのでしょうか?
できましたら、マクロ実行をしなくても自動で実行されるものがよいのですがよろしくお願いします。(シートモジュールになるのでしょうか?)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAについて 2 2023/01/31 16:21
- Excel(エクセル) エクセルで”入力シート”の文字書式の変更を”出力シート”で同じ文字書式で印刷したいです。VBA希望 4 2023/04/24 11:07
- Excel(エクセル) 【Excel】指定した文字列に該当する行を重複しないようにリスト 3 2022/03/30 12:27
- Excel(エクセル) エクセルでセルに何らかの文字が入力されたらそれを任意の数値として認識させる方法がしりたいです。 3 2023/03/16 20:19
- Visual Basic(VBA) Excel VBAでAA(BBB) → BBB.AA に置換したい 2 2022/10/30 13:59
- その他(プログラミング・Web制作) テキストエディタで複数行にわたる文字列の行頭に番号を振る方法 4 2023/03/11 12:57
- Excel(エクセル) エクセルの条件付き書式で*を使いたい 4 2022/05/13 16:49
- Excel(エクセル) PowerQueryに詳しい方教えてください(Office365) 1 2022/07/24 21:11
- Word(ワード) Wordの表中の文字を選択した時の白黒反転の違い 1 2023/04/25 12:13
- Visual Basic(VBA) EXCEL VBA 単語置き換え について質問です ブック名 ぶぶぶ シート名 ししし セル V3〜 3 2023/03/08 01:41
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【エクセル】IF関数 Aまたは...
-
エクセルで指定したセルのどれ...
-
セルをクリック⇒そのセルに入力...
-
Excelでのコメント表示位置
-
エクセル 足して割る
-
対象セル内(複数)が埋まった...
-
Excel2003 の『コメント』の編...
-
貼り付けで複数セルに貼り付けたい
-
Excelで数式内の文字色を一部だ...
-
EXCEL VBA セルに既に入...
-
エクセルのセルの枠を超えて文...
-
エクセル “13ヶ月”を“1年1ヶ月...
-
excelの特定のセルの隣のセル指...
-
複数のセルのいずれかに数字が...
-
(Excel)数字記入セルの数値の後...
-
投資番組の専門家は どういうと...
-
【Excel】 セルの色での判断は...
-
エクセルの一つのセルに複数の...
-
エクセルの取り消し線が引けな...
-
枠に収まらない文字を非表示に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル 足して割る
-
【エクセル】IF関数 Aまたは...
-
エクセルで指定したセルのどれ...
-
Excelで数式内の文字色を一部だ...
-
Excelでのコメント表示位置
-
貼り付けで複数セルに貼り付けたい
-
対象セル内(複数)が埋まった...
-
セルをクリック⇒そのセルに入力...
-
【Excel】 セルの色での判断は...
-
エクセルの一つのセルに複数の...
-
EXCEL VBA セルに既に入...
-
エクセル “13ヶ月”を“1年1ヶ月...
-
エクセル オートフィルタで絞...
-
エクセルのセルの枠を超えて文...
-
excelのCOUNTIF関数で、『範囲=...
-
(Excel)数字記入セルの数値の後...
-
枠に収まらない文字を非表示に...
-
Excel2003 の『コメント』の編...
-
Excel 例A(1+9) のように番地の...
-
複数のセルのいずれかに数字が...
おすすめ情報