[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『人別にデータをまとめる』（maco）
いつもお世話になります。
過去ログを検索しましたが解決策を見つけられなかったので投稿させていただきました。 社内で使用しているメールのデータまとめを行っております。 例えば、9月に受信したメールは誰から何件かというまとめです。 まず受信メールを全件選択し、エクセルに貼り付けます。
A B C D E 1 送信者 日付 時刻 サイズ 件名 2 Hanako Yamasita 2008/*/# @:@@ &&& etcetc 3 Tarou Satou 4 maco Suzuki 5 山下 花子 ・・・・省略・・・・ 6 佐藤 太郎 7 Hanako Yamasita
上記のようになり、データは3千件ほどあります。 これを人ごとに分けるために並べ替えをしたのですが、漢字と英数が混ざっているので Hanako Yamasitaと山下花子は同じ人物でも並べ替えでは離れてしまします。 PHONETIC関数で振り仮名欄を付け加えてみたらどうかな？などと自分なりに思いつくことを試してみましたが、 漢字を英数の振り仮名で表すことはできないのですね(^_^;)恥
知識薄のため、何かいい方法を教えていただけたら幸いです。
マクロでやっつける方法です。
新しいブックで試してくらはい。
Alt＋F11 → 挿入 → 標準モジュール を選択して下のコードを貼り付けます。
戻って
Sheet1のA列からE列に適当なデータを放り込みます。
Alt+F8でmacoを実行すると。。。どうでっか？ こんな塩梅で。
（弥太郎）
'-------------------------
Sub maco()
Dim i As Long, u As Integer, data As String, swch As String, ary1, ary2, tbl
Application.ScreenUpdating = False
ary1 = Array("a", "i", "u", "e", "o", "ka", "ki", "ku", "ke", "ko", "sa", "si", "su", "se", "so", _
"ta", "ti", "tu", "te", "to", "na", "ni", "nu", "ne", "no", "ha", "hi", "hu", "he", "ho", _
"ma", "mi", "mu", "me", "mo", "ya", "yu", "yo", "ra", "ri", "ru", "re", "ro", _
"wa", "wo", "n", "ga", "gi", "gu", "ge", "go", "gya", "gyu", "gyo", "za", "zi", _
"zu", "ze", "zo", "zya", "zyu", "zyo", "da", "di", "du", "de", "do", _
"cha", "cyu", "cyo", "nay", "nyu", "nyo", "ba", "bi", "bu", "be", "bo", _
"pa", "pi", "pu", "pe", "po", "bya", "byu", "byo", "pya", "pyu", "pyo", _
"hya", "hyu", "hyo", "rya", "ryu", "ryo")
ary2 = Array("ア", "イ", "ウ", "エ", "オ", "カ", "キ", "ク", "ケ", "コ", "サ", "シ", "ス", _
"セ", "ソ", "タ", "チ", "ツ", "テ", "ト", "ナ", "ニ", "ヌ", "ネ", "ノ", "ハ", "ヒ", _
"フ", "ヘ", "ホ", "マ", "ミ", "ム", "メ", "モ", "ヤ", "ユ", "ヨ", "ラ", "リ", _
"ル", "レ", "ロ", "ワ", "ヲ", "ン", "ガ", "ギ", "グ", "ゲ", "ゴ", _
"ギャ", "ギュ", "ギョ", "ザ", "ジ", "ズ", "ゼ", "ゾ", "ジャ", "ジュ", _
"ジョ", "ダ", "ヂ", "ヅ", "デェ", "ド", "チャ", "チュ", "チョ", "ニャ", _
"ニュ", "ニョ", "バ", "ビ", "ブ", "ベ", "ボ", "パ", "ピ", _
"プ", "ペ", "ポ", "ビャ", "ビュ", "ビョ", "ピャ", "ピュ", "ピョ", _
"ヒャ", "ヒュ", "ヒョ", "リャ", "リュ", "リョ")
With Sheets("sheet1")
.Range("a:a").SetPhonetic
.Range("a2").Resize(.Range("a" & Rows.Count).End(xlUp).Row - 1, 5).Copy
End With
Sheets.Add.Name = "dmy"
With Sheets("dmy")
.Range("A1").PasteSpecial Paste:=xlAll
.Range("f1").Resize(.Range("a" & Rows.Count).End(xlUp).Row).Formula = "=phonetic(a1)"
tbl = .Range("a1").Resize(.Range("a" & Rows.Count).End(xlUp).Row, 6)
ReDim x(1 To UBound(tbl, 1), 1 To 1)
For i = 1 To UBound(tbl, 1)
If tbl(i, 6) Like "*[ア-ン]*" Then
data = Replace(tbl(i, 6), " ", " ")
data = Split(data, " ")(1) & Space(1) & Split(data, " ")(0)
For u = 1 To Len(data)
If Mid(data, u, 1) <> Space(1) Then
swch = swch & ary1(Application.Match(Mid(data, u, 1), ary2, 0) - 1)
Else
swch = swch & Space(1)
End If
Next u
End If
x(i, 1) = IIf(swch = "", tbl(i, 6), swch)
swch = ""
Next i
.Range("f1").Resize(UBound(tbl, 1)) = x
.Range("a1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Sort key1:=.Range("f1")
.Range("a1").Resize(UBound(tbl, 1), 5).Copy
Sheets("sheet1").Range("a2").PasteSpecial Paste:=xlAll
Application.DisplayAlerts = False
.Delete
End With
Range("a1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
デェ？ ピャが2回・・・ あとできれば「ひゃ、ひゅ、ひょ、りゃ、りゅ、りょ」 を追加していただくとより素晴らしいものが！ （通りすがり）
なるほろ～。 「バグです」では切り抜けられんミスでんなぁ。＾＾ 訂正しときました。おおきに。
macoはん、通りすがりはんからイチャモンが付きましたモンで、新しいのと差し替えて おくんなはれ。 （弥太郎）
「漢字を英数の振り仮名で表すことはできないのですね」とあるので。 振り仮名欄があると仮定して。 振り仮名をASC関数で半角に。（ =ASC(PHONETIC(対象) 見たいな感じ） http://www.excel.studio-kazu.jp/DL/#q07のページにある （８）カタカナローマ字変換[ヘボン式](2003/09/02) を使用して半角カタカナをローマ字に変更。 で、上記ができるのかな？
目的達成には、苗字と名前の位置入替えたりしないといけない、気がする。 マクロは、今のところ全く分からないのでこのくらいで勘弁をば。
（名前はまだない）
弥太郎さん 通りすがりさん 名前はまだないさんへ
ありがとうございます！ 別の仕事が入りきちんと動作確認させていただく時間がないので、明日勉強させていただきます。 ご連絡が遅くなりすみません<m(__)m>
maco
このデータには メールアドレスはないのですかね。 あるのならメールアドレスで集計をするのが 確実な様に思いますが・・・。
送信者名が必要であれば、メールアドレスから 送信者を割り当て （VLOOKUP関数等で、上側にある名前を参照させる） ても良い様に思います。
・・・まぁ、情報にメールアドレスがないと ダメですけどね。
でもこれって 「名字だけしか登録されていない」 「苗字・名前の順にローマ字で書いてある」 「送信者名がメールアドレスになっている」 なんてデータはないのですかね。
「河野」さんは「Kawano」さん？「Kouno」さん？
いちゃもんついでに ＞受信メールを全件選択し、エクセルに貼り付けます。 ですから、漢字データに振り仮名情報は含まれていないと思います。 よって ＞ "=phonetic(a1)" では、無理があるんじゃないですかね。
まぁ、ほかの列に振り仮名がある列があるなら その列を使えば良いのでしょうけど。
(HANA)
＞ "=phonetic(a1)" では、無理があるんじゃないですかね。
さいです、さいです。 ＞受信メールを全件選択し、エクセルに貼り付けます。 を見落としとりましたワ。
まあ、正確性を欠きますけどとりあえず臨時にフリガナを振って、それを元にソート するよう組み替えときました。 よくよく考えリャ姓ではなくて名前でソートしとりますけど、これでええんでっしゃろ か？ （弥太郎）
おはようございます。
HANAさんおっしゃる通り、漢字データに振り仮名情報は含まれていないということに今更気がつきました。 昨日PHONETICを試してみたときは貼り付けた情報ではなく、自分でテスト用に作ったデータで試して いたのできちんと振り仮名が出ていただけのことでした。 弥太郎さんにも面倒をかけてしまいすみません。
>このデータには メールアドレスはないのですかね。 メールアドレスは受信履歴画面に出ないので、アドレスで集計ができません。
弥太郎さんに作成していただいたマクロを実行しました。 実行すると、型が一致しませんとエラーメッセージが出て、 swch = swch & ary1(Application.Match(Mid(data, u, 1), ary2, 0) - 1)の行にデバッグが出ます。 エラーメッセージを閉じると、振り仮名列が追記された状態でdmyシートが作成されます。
>よくよく考えリャ姓ではなくて名前でソートしとりますけど、これでええんでっしゃろか？ 姓でソートしたいです。伝えたいことがうまく言えずすみません(>_<;) maco Suzukiと鈴木眞子では姓名が逆なので、混合しているとやはり難しいでしょうか・・・。
maco
当初からの疑問･･･ 眞子は maco？ mako？ excelがどうやって判断するか･･･
姓でと申してもあいうえお順に並べ替えるには骨が折れます。
abcの順になりますけど、こんな塩梅になります。
エラーで止まったらマウスをそれぞれの変数に近づけてみてくらはい。
data は 何になってます？
u は？
swch は？
Len(data) は？
（弥太郎）
'-------------------------
Sub maco2()
Dim i As Long, u As Integer, data As String, swch As String, ary1, ary2, tbl
Application.ScreenUpdating = False
ary1 = Array("a", "i", "u", "e", "o", "ka", "ki", "ku", "ke", "ko", "sa", "si", "su", "se", "so", _
"ta", "ti", "tu", "te", "to", "na", "ni", "nu", "ne", "no", "ha", "hi", "hu", "he", "ho", _
"ma", "mi", "mu", "me", "mo", "ya", "yu", "yo", "ra", "ri", "ru", "re", "ro", _
"wa", "wo", "n", "ga", "gi", "gu", "ge", "go", "gya", "gyu", "gyo", "za", "zi", _
"zu", "ze", "zo", "zya", "zyu", "zyo", "da", "di", "du", "de", "do", _
"cha", "cyu", "cyo", "nya", "nyu", "nyo", "ba", "bi", "bu", "be", "bo", _
"pa", "pi", "pu", "pe", "po", "bya", "byu", "byo", "pya", "pyu", "pyo", _
"hya", "hyu", "hyo", "rya", "ryu", "ryo")
ary2 = Array("ア", "イ", "ウ", "エ", "オ", "カ", "キ", "ク", "ケ", "コ", "サ", "シ", "ス", _
"セ", "ソ", "タ", "チ", "ツ", "テ", "ト", "ナ", "ニ", "ヌ", "ネ", "ノ", "ハ", "ヒ", _
"フ", "ヘ", "ホ", "マ", "ミ", "ム", "メ", "モ", "ヤ", "ユ", "ヨ", "ラ", "リ", _
"ル", "レ", "ロ", "ワ", "ヲ", "ン", "ガ", "ギ", "グ", "ゲ", "ゴ", _
"ギャ", "ギュ", "ギョ", "ザ", "ジ", "ズ", "ゼ", "ゾ", "ジャ", "ジュ", _
"ジョ", "ダ", "ヂ", "ヅ", "デェ", "ド", "チャ", "チュ", "チョ", "ニャ", _
"ニュ", "ニョ", "バ", "ビ", "ブ", "ベ", "ボ", "パ", "ピ", _
"プ", "ペ", "ポ", "ビャ", "ビュ", "ビョ", "ピャ", "ピュ", "ピョ", _
"ヒャ", "ヒュ", "ヒョ", "リャ", "リュ", "リョ")
With Sheets("sheet1")
.Range("a:a").SetPhonetic
.Range("a2").Resize(.Range("a" & Rows.Count).End(xlUp).Row - 1, 5).Copy
End With
Sheets.Add.Name = "dmy"
With Sheets("dmy")
.Range("A1").PasteSpecial Paste:=xlAll
.Range("f1").Resize(.Range("a" & Rows.Count).End(xlUp).Row).Formula = "=phonetic(a1)"
tbl = .Range("a1").Resize(.Range("a" & Rows.Count).End(xlUp).Row, 6)
ReDim x(1 To UBound(tbl, 1), 1 To 1)
For i = 1 To UBound(tbl, 1)
data = Replace(tbl(i, 6), " ", " ")
If data Like "*[ア-ン]*" Then
For u = 1 To Len(data)
If Mid(data, u, 1) <> Space(1) Then
swch = swch & ary1(Application.Match(Mid(data, u, 1), ary2, 0) - 1)
Else
swch = swch & Space(1)
End If
Next u
Else
swch = Split(data, " ")(1) & Space(1) & Split(data, " ")(0)
End If
x(i, 1) = swch
swch = ""
Next i
.Range("f1").Resize(UBound(tbl, 1)) = x
.Range("a1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Sort key1:=.Range("f1")
.Range("a1").Resize(UBound(tbl, 1), 5).Copy
Sheets("sheet1").Range("a2").PasteSpecial Paste:=xlAll
Application.DisplayAlerts = False
.Delete
End With
Range("a1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
下から失礼ですが、そのデータはどこから持ってくるのでしょうか。
受信履歴にメールアドレスが無い、とのことですが「受信履歴」とやらを表示している 側で表示を出すことはできませんか？
メールアドレスをデータとして利用できれば、話が簡単な気がするのですが。 (Mook)
この作業は一回限りでしょうか？ それとも、今後も続くのでしょうか。
また、 ＞メールアドレスは受信履歴画面に出ないので、アドレスで集計ができません。 と言う事ですが、表示されている名前は 相手方から 送られてきた時の名前 と言う事なんですよね。 名前を登録してない人もいると思いますが そう言うのはどうなっているのですかね・・・。
来月も継続して続くのなら、最初は面倒でも それぞれの受信名に対する 名前一覧を 今の内に作っておくのが良いように思います。
最初は量も多くて大変でしょうし 今後追加が有った場合は追加が必要に成りますが・・・・。 自動で読ませた場合は 毎回チェックが必要になりますので それも手間だと思います。
もしも、受信者名付でアドレス帳に登録がしてあるのなら それを取り出して 名前でメールアドレスを関連づけ 集計する方法も有ると思います。
(HANA)
皆様 いろいろなご指摘をありがとうございます。 HANAさんのおっしゃるように、面倒でも一覧を作っておくことにします。
弥太郎さん マクロを作っていただき、大変なご足労をおかけしてしまいました。 すみません。 本当にありがとうございました。
(maco)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.