Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3767 / 13646 ツリー ←次へ | 前へ→

【59994】複数のセルを選択 なっちょめ 09/1/22(木) 20:54 質問[未読]
【59995】Re:複数のセルを選択 ichinose 09/1/22(木) 21:31 発言[未読]
【60007】Re:複数のセルを選択 なっちょめ 09/1/23(金) 12:41 質問[未読]
【60015】Re:複数のセルを選択 ichinose 09/1/23(金) 15:07 発言[未読]
【60219】Re:複数のセルを選択 なっちょめ 09/2/4(水) 23:23 質問[未読]
【60220】Re:複数のセルを選択 ichinose 09/2/4(水) 23:42 発言[未読]
【60272】Re:複数のセルを選択 なっちょめ 09/2/6(金) 17:51 質問[未読]
【60290】Re:複数のセルを選択 ichinose 09/2/7(土) 22:08 発言[未読]
【60307】Re:複数のセルを選択 なっちょめ 09/2/9(月) 11:59 お礼[未読]
【60016】Re:複数のセルを選択 プルート 09/1/23(金) 16:18 発言[未読]
【60021】Re:複数のセルを選択 なっちょめ 09/1/23(金) 18:17 お礼[未読]
【60028】Re:複数のセルを選択 なっちょめ 09/1/24(土) 14:09 お礼[未読]

【59994】複数のセルを選択
質問  なっちょめ E-MAIL  - 09/1/22(木) 20:54 -

引用なし
パスワード
   お世話になります。
初心者の質問でご迷惑をかけるかもしれませんが、
宜しくお願いします。

選択しているセルの中で、全く同じ”値”が入っているか
どうか調べるにはどのように書けばいいのですか?

Range("B1:B5,B10:B11").Selection

例えば、この範囲の中で同じ値が入っているか調べたいのですが、
どのように書いたらいいのでしょうか?

質問内容に不備があればご指摘下さい。

宜しくお願いいたします。

【59995】Re:複数のセルを選択
発言  ichinose  - 09/1/22(木) 21:31 -

引用なし
パスワード
   ▼なっちょめ さん:
こんばんは。


>お世話になります。
>初心者の質問でご迷惑をかけるかもしれませんが、
>宜しくお願いします。
>
>選択しているセルの中で、全く同じ”値”が入っているか
>どうか調べるにはどのように書けばいいのですか?
>
>Range("B1:B5,B10:B11").Selection
>↑
>例えば、この範囲の中で同じ値が入っているか調べたいのですが、
>どのように書いたらいいのでしょうか?
>
>質問内容に不備があればご指摘下さい。
>
>宜しくお願いいたします。


Sub sample()
  Dim crng As Range
  Dim kk As Variant
  With CreateObject("scripting.dictionary")
    For Each crng In Range("b1:b5,B10:B11")
     If Not .Exists(CStr(crng.Value)) Then
       Set .Item(CStr(crng.Value)) = crng
     Else
       Set .Item(CStr(crng.Value)) = Application.Union(.Item(CStr(crng.Value)), crng)
     End If
    Next
    For Each kk In .Keys
    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
    Next
  End With
End Sub


これで試してみてください

【60007】Re:複数のセルを選択
質問  なっちょめ E-MAIL  - 09/1/23(金) 12:41 -

引用なし
パスワード
   ▼ichinose さん:

お世話になっております。
ichinoseさん、ご返答ありがとうございます。

私の質問内容が悪かったです。
同じ”値”が入っているかどうかという事で、
投稿させてもらっていましたが、これには文字列も比較対照に
入っています。
例えば”TEST"という文字と、"TEST"だと、同じ値。
"TEST”という文字と" TEST"だと、後者にはスペースが入っているので
違う値。という風に出したいです。


>▼なっちょめ さん:
>こんばんは。
>
>
>>お世話になります。
>>初心者の質問でご迷惑をかけるかもしれませんが、
>>宜しくお願いします。
>>
>>選択しているセルの中で、全く同じ”値”が入っているか
>>どうか調べるにはどのように書けばいいのですか?
>>
>>Range("B1:B5,B10:B11").Selection
>>↑
>>例えば、この範囲の中で同じ値が入っているか調べたいのですが、
>>どのように書いたらいいのでしょうか?
>>
>>質問内容に不備があればご指摘下さい。
>>
>>宜しくお願いいたします。
>
>
>Sub sample()
>  Dim crng As Range
>  Dim kk As Variant
>  With CreateObject("scripting.dictionary")
>    For Each crng In Range("b1:b5,B10:B11")
>     If Not .Exists(CStr(crng.Value)) Then
>       Set .Item(CStr(crng.Value)) = crng
>     Else
>       Set .Item(CStr(crng.Value)) = Application.Union(.Item(CStr(crng.Value)), crng)
>     End If
>    Next
>    For Each kk In .Keys
>    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
>    Next
>  End With
>End Sub
>
>
>これで試してみてください

【60015】Re:複数のセルを選択
発言  ichinose  - 09/1/23(金) 15:07 -

引用なし
パスワード
   こんにちは。

仕事中なのできちんとは検証してませんが、


>同じ”値”が入っているかどうかという事で、
>投稿させてもらっていましたが、これには文字列も比較対照に
>入っています。
>例えば”TEST"という文字と、"TEST"だと、同じ値。
>"TEST”という文字と" TEST"だと、後者にはスペースが入っているので
>違う値。という風に出したいです。
そうなっているはずですが・・・。
以下のテストデータで試してみてください

Sub sample()
  Dim crng As Range
  Dim kk As Variant
  With Range("b1:b5,B10:B11")
    With .Areas(1)
     .Cells(1).Value = "TEST"
     .Cells(2).Value = " TEST"
     .Cells(3).Value = "TEST"
     .Cells(4).Value = " TEST"
     .Cells(5).Value = "aaaa"
    End With
    With .Areas(2)
     .Cells(1).Value = "aaaa"
     .Cells(2).Value = " TEST"
    End With
  End With
  MsgBox "上記のデータでテストします"
  With CreateObject("scripting.dictionary")
    For Each crng In Range("b1:b5,B10:B11")
     If Not .Exists(CStr(crng.Value)) Then
       Set .Item(CStr(crng.Value)) = crng
     Else
       Set .Item(CStr(crng.Value)) = Application.Union(.Item(CStr(crng.Value)), crng)
     End If
    Next
    For Each kk In .Keys
    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
    Next
  End With
End Sub


後は、夜の返信になります。

【60016】Re:複数のセルを選択
発言  プルート  - 09/1/23(金) 16:18 -

引用なし
パスワード
   ▼なっちょめ さん:
ichinose さん

横から失礼します。

最近、scripting.dictionary を使い始めました。
ichinoseさんのコード、便乗して勉強させていただきます^^;;

私の環境でも正常に動いたのでコードは問題ないかと思います。


>    For Each kk In .Keys
      If .Item(kk).Count > 1 Then
>       MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
      End If
>    Next

と付け加えると分かりやすいかもしれません。

【60021】Re:複数のセルを選択
お礼  なっちょめ E-MAIL  - 09/1/23(金) 18:17 -

引用なし
パスワード
   ▼プルート さん:
▼ichinose さん:

お世話になっております。
ご返答ありがとうございます。
今回、教えて頂いた内容を自分でよく理解して進めてみます。
素人で調べるのにも時間がかかってしまうとは思いますが、
結果は必ず報告させて頂きます。
親切に教えていただき、ありがとうございます。

今後とも宜しくお願いいたします。

>▼なっちょめ さん:
>ichinose さん
>
>横から失礼します。
>
>最近、scripting.dictionary を使い始めました。
>ichinoseさんのコード、便乗して勉強させていただきます^^;;
>
>私の環境でも正常に動いたのでコードは問題ないかと思います。
>
>
>>    For Each kk In .Keys
>      If .Item(kk).Count > 1 Then
>>       MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
>      End If
>>    Next
>
>と付け加えると分かりやすいかもしれません。

【60028】Re:複数のセルを選択
お礼  なっちょめ E-MAIL  - 09/1/24(土) 14:09 -

引用なし
パスワード
   ▼ichinose さん:
▼プルート さん:

お世話になっております。
ichinoseさん、プルートさんから教えていただいた内容で
完璧に自分がやりたかった事が実現できました。
大変勉強になりました。
お忙しい中大変ありがとうございました。


>▼なっちょめ さん:
>ichinose さん
>
>横から失礼します。
>
>最近、scripting.dictionary を使い始めました。
>ichinoseさんのコード、便乗して勉強させていただきます^^;;
>
>私の環境でも正常に動いたのでコードは問題ないかと思います。
>
>
>>    For Each kk In .Keys
>      If .Item(kk).Count > 1 Then
>>       MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
>      End If
>>    Next
>
>と付け加えると分かりやすいかもしれません。

【60219】Re:複数のセルを選択
質問  なっちょめ E-MAIL  - 09/2/4(水) 23:23 -

引用なし
パスワード
   ▼ichinose さん:
▼プルート さん:
お世話になっております。

先日、教えていただいた内容で再度ご教授を
お願いしたい点があり投稿させて頂いています。

私の勘違いで比較のやり方が失敗していました。
"TEST"と"test"で同じ値。"test"と" test"でも(ブランクがあっても)同じ値。
というふうに結果を返したいのですが、先日教えていただいたコードを
少し変えるだけで対応可能なのでしょうか?
何度も申し訳ありませんが、よろしければご教授お願いいたします。


>こんにちは。
>
>仕事中なのできちんとは検証してませんが、
>
>
>>同じ”値”が入っているかどうかという事で、
>>投稿させてもらっていましたが、これには文字列も比較対照に
>>入っています。
>>例えば”TEST"という文字と、"TEST"だと、同じ値。
>>"TEST”という文字と" TEST"だと、後者にはスペースが入っているので
>>違う値。という風に出したいです。
>そうなっているはずですが・・・。
>以下のテストデータで試してみてください
>
>Sub sample()
>  Dim crng As Range
>  Dim kk As Variant
>  With Range("b1:b5,B10:B11")
>    With .Areas(1)
>     .Cells(1).Value = "TEST"
>     .Cells(2).Value = " TEST"
>     .Cells(3).Value = "TEST"
>     .Cells(4).Value = " TEST"
>     .Cells(5).Value = "aaaa"
>    End With
>    With .Areas(2)
>     .Cells(1).Value = "aaaa"
>     .Cells(2).Value = " TEST"
>    End With
>  End With
>  MsgBox "上記のデータでテストします"
>  With CreateObject("scripting.dictionary")
>    For Each crng In Range("b1:b5,B10:B11")
>     If Not .Exists(CStr(crng.Value)) Then
>       Set .Item(CStr(crng.Value)) = crng
>     Else
>       Set .Item(CStr(crng.Value)) = Application.Union(.Item(CStr(crng.Value)), crng)
>     End If
>    Next
>    For Each kk In .Keys
>    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
>    Next
>  End With
>End Sub
>
>
>後は、夜の返信になります。

【60220】Re:複数のセルを選択
発言  ichinose  - 09/2/4(水) 23:42 -

引用なし
パスワード
   こんばんは。


>"TEST"と"test"で同じ値。"test"と" test"でも(ブランクがあっても)同じ値。
>というふうに結果を返したいのですが、先日教えていただいたコードを
>少し変えるだけで対応可能なのでしょうか?

Sub sample()
  Dim crng As Range
  Dim kk As Variant
  With Range("b1:b5,B10:B11")
    With .Areas(1)
     .Cells(1).Value = "TEST"
     .Cells(2).Value = " TEST"
     .Cells(3).Value = "test"
     .Cells(4).Value = " test"
     .Cells(5).Value = "aaaa"
    End With
    With .Areas(2)
     .Cells(1).Value = "aaaa"
     .Cells(2).Value = " TEST"
    End With
  End With
  MsgBox "上記のデータでテストします"
  With CreateObject("scripting.dictionary")
    For Each crng In Range("b1:b5,B10:B11")
     If Not .Exists(UCase(Trim(CStr(crng.Value)))) Then
       Set .Item(UCase(Trim(CStr(crng.Value)))) = crng
     Else
       Set .Item(UCase(Trim(CStr(crng.Value)))) = Application.Union(.Item(UCase(Trim(CStr(crng.Value)))), crng)
     End If
    Next
    For Each kk In .Keys
    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
    Next
  End With
End Sub

この程度で良ければ、ちょっとの変更で済みます

【60272】Re:複数のセルを選択
質問  なっちょめ E-MAIL  - 09/2/6(金) 17:51 -

引用なし
パスワード
   ▼ichinose さん:

いつもお返事ありがとうございます。
本当に何度も申し訳ありません。
甘えてはいけないと思いつつも・・・、また投稿してしまいました。

今回の件で、全角と半角でも同じ値、「あ」と「ア」でも同じ値を
返すには、どうしたらいいのでしょうか?
少しのヒントでも構いません、なにかしらあれば
教えていただけないでしょうか?

ichinoseさんから教えていただいたコードに
Strconv等の関数を更に付け加えればいけるのかなと思い、
色々試してはみたのですが・・・・


>こんばんは。
>
>
>>"TEST"と"test"で同じ値。"test"と" test"でも(ブランクがあっても)同じ値。
>>というふうに結果を返したいのですが、先日教えていただいたコードを
>>少し変えるだけで対応可能なのでしょうか?
>
>Sub sample()
>  Dim crng As Range
>  Dim kk As Variant
>  With Range("b1:b5,B10:B11")
>    With .Areas(1)
>     .Cells(1).Value = "TEST"
>     .Cells(2).Value = " TEST"
>     .Cells(3).Value = "test"
>     .Cells(4).Value = " test"
>     .Cells(5).Value = "aaaa"
>    End With
>    With .Areas(2)
>     .Cells(1).Value = "aaaa"
>     .Cells(2).Value = " TEST"
>    End With
>  End With
>  MsgBox "上記のデータでテストします"
>  With CreateObject("scripting.dictionary")
>    For Each crng In Range("b1:b5,B10:B11")
>     If Not .Exists(UCase(Trim(CStr(crng.Value)))) Then
>       Set .Item(UCase(Trim(CStr(crng.Value)))) = crng
>     Else
>       Set .Item(UCase(Trim(CStr(crng.Value)))) = Application.Union(.Item(UCase(Trim(CStr(crng.Value)))), crng)
>     End If
>    Next
>    For Each kk In .Keys
>    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
>    Next
>  End With
>End Sub
>
>この程度で良ければ、ちょっとの変更で済みます

【60290】Re:複数のセルを選択
発言  ichinose  - 09/2/7(土) 22:08 -

引用なし
パスワード
   こんばんは。


>今回の件で、全角と半角でも同じ値、「あ」と「ア」でも同じ値を
>返すには、どうしたらいいのでしょうか?
>少しのヒントでも構いません、なにかしらあれば
>教えていただけないでしょうか?
>
>ichinoseさんから教えていただいたコードに
>Strconv等の関数を更に付け加えればいけるのかなと思い、
>色々試してはみたのですが・・・・
Strconv関数をどのように試してダメだったかを必ず、記述して下さい
その記述がいずれは、貴重な資料になると思いますから・・・。


Sub sample()
  Dim crng As Range
  Dim kk As Variant
  Dim cnvstr As String
  With Range("b1:b5,B10:B11")
    With .Areas(1)
     .Cells(1).Value = "あいう"
     .Cells(2).Value = " TEST"
     .Cells(3).Value = "TEST"
     .Cells(4).Value = " アイウ"
     .Cells(5).Value = "aaaa"
    End With
    With .Areas(2)
     .Cells(1).Value = "aaaa"
     .Cells(2).Value = " TEST"
    End With
  End With
  MsgBox "上記のデータでテストします"
  With CreateObject("scripting.dictionary")
    For Each crng In Range("b1:b5,B10:B11")
     cnvstr = StrConv(StrConv(UCase(Trim(CStr(crng.Value))), vbWide), vbKatakana)
     If Not .Exists(cnvstr) Then
       Set .Item(cnvstr) = crng
     Else
       Set .Item(cnvstr) = Application.Union(.Item(cnvstr), crng)
     End If
    Next
    For Each kk In .Keys
    MsgBox kk & " という値で " & .Item(kk).Address & " が同じ"
    Next
  End With
End Sub


これで試してみて下さい。

【60307】Re:複数のセルを選択
お礼  なっちょめ E-MAIL  - 09/2/9(月) 11:59 -

引用なし
パスワード
   ichinoseさん

いつもお世話になっております。
まずは、お礼を。
やりたい事は完璧にできました。
ありがとうございました。

あと、どのように試してみたのかという所を記載していなくて
申し訳ありませんでした。
今後は、自分でやった事、試してみた事を記載するようにします。
ご指摘ありがとうございました。
(自分の履歴をみるのにも大切だと思います)

それでは、実際どのようにstrconvを使って試してみたかというと、
恥ずかしいですが下記のようなコードを書いていたと思います。

If Not .Exists(Strconv(UCase(Trim(CStr(crng.Value))),vbKATAKANA) Then
  Set .Item(Strconv(UCase(Trim(CStr(crng.Value))),vbkatakana) = crng
Else
  Set .Item(Strconv(UCase(Trim(CStr(crng.Value))),vbkatakana) = Application.Union(.Item(Strconv(UCase(Trim(CStr(crng.Value))),vbkatakana), crng)
End If

ど素人ですいません・・・。
本当にありがとうございました。

3767 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free