プロが教える店舗&オフィスのセキュリティ対策術

ある文字列の中から漢字のみを抜きだしセルに表示、その漢字の個数とそれぞれの漢字の個数をセルに表示するにはどのようなプログラムにしたらよいのでしょうか?
例えば、「私は昨日、日光東照宮へ私の家族といっしょに行った」⇒私2、昨1、日2、…漢字の総数12というような感じです。拙い説明で分かりずらいかもしれませんが、わかる方どうかお力を貸してください。

A 回答 (3件)

続けてお邪魔します。



>もう少し簡単なプログラムがあれば・・・
というコトですが、この程度しか思いつきませんので、
前回のコードとその説明を加えたものをもう一度載せてみます。

Sub Sample1()
'変数の宣言
Dim k As Long, cnt As Long, str As String, c As Range

'C・D列の消去
Range("C:D").ClearContents

'A1セルの1文字目~最終文字まで
For k = 1 To Len(Range("A1"))

'一文字ずつを変数(str)に格納
str = Mid(Range("A1"), k, 1)

'もしstrが「漢字」であれば・・・(おそらくすべての漢字が網羅されていると思います)
If str Like "[一-黑]" Then

'C列に「str」が存在するかどうか確認
Set c = Range("C:C").Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)

'もしC列に「str」がなければ
If c Is Nothing Then

'cnt(表示用の行番号として使用)を1つずつ増やす
cnt = cnt + 1 '←最初は「1」となる

'C列の「cnt」行の
With Cells(cnt, "C")

'値はstrを代入
.Value = str

'その右隣りのセルに「1」を代入
.Offset(, 1) = 1
End With

'そうでない場合は
Else

'C列にstrがある行の右隣りの値は、入力済みの数値に1をプラス
c.Offset(, 1) = c.Offset(, 1) + 1
End If
End If

'次のk(文字)へ!←(A1セルの最後の文字まで一文字ずつ順にループ)
Next k

'C列最終行の2行下のセルの
With Cells(Rows.Count, "C").End(xlUp).Offset(2)

'値は「総数」に
.Value = "総数"

'その右隣りのセルはD列数値の合計を!
.Offset(, 1) = WorksheetFunction.Sum(Range("D:D"))
End With
End Sub

※ 一応上記のような考え方でのコードです。
この程度でよろしいでしょうかね?m(_ _)m
    • good
    • 0
この回答へのお礼

わかりやすい説明をありがとうございます!!
大変たすかりました。また何かありましたらお願いします!

お礼日時:2013/12/02 21:30

No.1です!


たびたびごめんなさい。

前回のコードの
>If str Like "[亜-黑]" Then
の行を
>If str Like "[一-黑]" Then
に変更してください。
前回のコードでは漏れがあるみたいです。

※ 今回も詳しく検証していませんので漏れがあったらごめんなさいね。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございます!!
実行してみたらちゃんとできました。
ただVBA超初心者なんで何が何を意味してるかが分からないのでもう少し簡単なプログラムがあれば、もしくは簡単で構わないので説明していただけるとありがたいです汗。

お礼日時:2013/12/02 20:14

こんばんは!


色々やり方はあると思いますが、一例です。

「ある文字列」はA1セルにあるとし、C列に漢字を、D列に個数を表示するとします。
Sheetモジュールです。

Sub Sample1()
Dim k As Long, cnt As Long, str As String, c As Range
Range("C:D").ClearContents
For k = 1 To Len(Range("A1"))
str = Mid(Range("A1"), k, 1)
If str Like "[亜-黑]" Then
Set c = Range("C:C").Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
cnt = cnt + 1
With Cells(cnt, "C")
.Value = str
.Offset(, 1) = 1
End With
Else
c.Offset(, 1) = c.Offset(, 1) + 1
End If
End If
Next k
With Cells(Rows.Count, "C").End(xlUp).Offset(2)
.Value = "総数"
.Offset(, 1) = WorksheetFunction.Sum(Range("D:D"))
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!