|A|B|C|D|
--------------
1|あ|い|う|え|
--------------
2|お|あ|あ|か|
--------------
上記は1行目に左から「あ」「い」「う」「え」が入力されていることを表しています。
この表の中から、一番多く入力されている文字だけを別のセルに抽出させるにはどのようにしたら良いでしょうか。
上記の例を使用すると、A列の5行目(任意のセル)に「あ」と抽出するようにしたいです。
いろいろと調べてみましたが、このように表の中で最も多く入力されている、「文字」または「数字」だけを抽出するという処理方法がみつかりませんでした。
マクロなら可能でしょうか?
このような処理ができる関数もなさそうなので、無理なのかな。
アドバイスを御願い致します。
A 回答 (13件中1~10件)
- 最新から表示
- 回答順に表示
No.13
- 回答日時:
No.8です。
前記のコード18行目(空白行を含む)の
> Cosu(i) = Cosu(i) + 1 は、
Cosu(i) = 1 に訂正します。
結果は変わらないのですが、気になったもので…。
…というか、For Each~Next間は、imogasiさん方式がいいですね。
No.12
- 回答日時:
#10の補足です。
>E1:F1に結果を出力してしまうと、最初にデータを入力していた部分と重なってしまわないでしょうか?
E1より右列にも、元データがあるのなら、例えば未使用のQ列、R列を使って下さい。それぐらいは修正変更して頂けるとの前提で書いてます。
下記に修正したものを書きます。どこを変えれば良いか
両者比較すればわかります。
>マクロの処理を連続して行ってみると、・・・加算される
そうですね。クリア処理が要りますね。
下記の最初の1行を追加します。
Sub test02()
Range("s1:t100").ClearContents
j = 1
Cells(1, "S") = Cells(1, "A")
Dim c As Range
For Each c In Range("a1:d5")
For i = 1 To j
If Cells(i, "S") = c Then
Cells(i, "T") = Cells(i, "T") + 1
GoTo p01
End If
Next i
j = j + 1
Cells(j, "S") = c
Cells(j, "T") = 1
p01:
Next
Range(Cells(1, "S"), Cells(j, "T")).Select
Selection.Sort Key1:=Range("T1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False
Cells(1, "Q") = Cells(1, "S")
Cells(1, "R") = Cells(1, "T")
End Sub
>このようなマクロの処理を数式のように常にアクティブな状態にさせることは可能でしょうか?
この処理は値を出して終わりと言う型ではないので、自家製関数には出来ません。
シートにボタンを1つ貼りつけ、必要な時、ボタンをクリックするとこの処理を実行すると言うのなら
Private Sub CommandButton1_Click()
End Sub
この真中に上記を挟むことによって可能です。
>データに変更がある度に、結果も変更されるようにできたらいいなと
これは無駄な処理を毎回データ入力時にさせることになり、データ数が多いと、入力レスポンスタイムに影響しイライラするのではないかと思いますので賛成しません。
こう言う要望の処理を、イベントを捉えるといいますが、シートのイベントとして「値が変った」、「セル選択が変った」などがありますが、私はこの内容に不満足でこれを使う気になりません。
No.11
- 回答日時:
プログラムでやるのも面倒くさいですね。
Unix系の標準のコマンドだけで実現できますので、参考に書いておきます。プログラムなんか組む必要はありません。No.9と同様、テキストファイル(CSV形式)に出力されているとします(例えばファイル名は、test.tblとします)。
[test.tbl内容]
あ,な,の,ん,と,に
か,た,さ,ぱ,な,す
す,ろ,ふ,べ,ほ,じ
あ,な,め,よ,り,に
り,な,ず,に,ち,ぱ
あ,な,け,ふ,と,み
こ,あ,て,べ,を,ね
#一番多かった文字を出力する例
cat test.tbl | tr ',' '\n' | sort | uniq -c | sort -rn | head -1 | cut -f2
#結果
な
#一番多かった文字を頻度とともに出力する例
cat test.tbl | tr ',' '\n' | sort | uniq -c | sort -rn | head -1
#結果
5な
#上位5個をの文字を頻度とともに出力する例
cat test.tbl | tr ',' '\n' | sort | uniq -c | sort -rn | head -5
5な
4あ
3に
2り
2べ
御回答ありがとうございます。
ん~、私の理解を超えてしまっています(^^;
ですが、処理結果の出力は私がやりたいことなんです。
これを、なんとかエクセルで実現できればと思います。
わざわざ回答して頂き、ありがとうございました。
また何かアドバイスがありましたら、よろしく御願いします。
No.10
- 回答日時:
ホンと長いプログラムが多いですね。
#9さんに触発されてSub test02()
j = 1
Cells(1, "H") = Cells(1, "A")
Dim c As Range
For Each c In Range("a1:d5")
For i = 1 To j
If Cells(i, "H") = c Then
Cells(i, "I") = Cells(i, "I") + 1
GoTo p01
End If
Next i
j = j + 1
Cells(j, "H") = c
Cells(j, "I") = 1
p01:
Next
Range(Cells(1, "H"), Cells(j, "I")).Select
Selection.Sort Key1:=Range("I1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False
Cells(1, "E") = Cells(1, "H")
Cells(1, "F") = Cells(1, "I")
End Sub
(テストデータ)A1:E5に
abcr
sast
acay
wafs
sdga
(結果)H1:I11に
a6
s4
c2
b1
r1
t1
y1
w1
f1
d1
g1
(結果)E1:F1に
a6
行数列数が増えたときどこを変えれば良いか判るでしょう。
御回答ありがとうございます。
これは私の要望にさらに機能を付けて頂いた処理になっていますね(^^)
実は多い順に表示できたらいいなー、とも思っていました。
実際に試してみたのですが、ちょっと上手くいきませんでした。
「(結果)E1:F1に
a 6 」
ですが、E1:F1に結果を出力してしまうと、最初にデータを入力していた部分と重なってしまわないでしょうか?
実際表示されませんでした。
あと、このようなマクロの処理を数式のように常にアクティブな状態にさせることは可能でしょうか?
データに変更がある度に、結果も変更されるようにできたらいいなと思います。
またこのマクロの処理を連続して行ってみると、もっとも多くある文字だけが加算されていってしまいます。
例の1部を使用して例えてみると、
<一回目>
a 6
s 4
c 2
<二回目>
a 12
s 4
c 2
<三回目>
a 18
s 4
c 2
と言ったように、処理した回数のみ加算されていきます。
何とか関数のみで多い順に表示したり、カウントしたりしようと考えてみましたが、かなり面倒な処理になってしまいそうです。
他に何かアドバイスがありましたら、よろしく御願いします。
No.9
- 回答日時:
どうしてもエクセル上(VBA)でやらなければ、いけないのでしょうか? 他の方の例を見ていると、VBAでは大変そうですね。
私だったら、テキストファイル(CSV形式)で出力して、Perlなどを使って処理します。例えば、こんな感じです。$file=@ARGV[0];
open(IN, "$file");
%NUM;
while(<IN>){
chop();
@record = split(/,/);
foreach $word (@record){
$NUM{$word}++;
}
}
close(IN);
$max_item = "";
$max_num = 0;
foreach $item (sort (keys(%NUM))){
printf("%s: %d\n", $item, $NUM{$item});
if($NUM{$item} > $max_num){
$max_num = $NUM{$item};
$max_item= $item;
}
}
printf("---------- MAX ----------\n");
printf("%s: %d\n", $max_item, $max_num);
この回答への補足
御回答ありがとうございます。
私以外の人も使用するので、やはりエクセルで処理することが必要になってきます。
Perlバージョンも参考にさせて頂きますね。
わざわざ、ありがとうございました。
No.8
- 回答日時:
時間ができたので、作ってみました。
VBAの標準モジュールに貼り付け、"挿入"→"関数"で、ユーザー定義関数として試してみてください。
Function InLarge(データ As Range) As String
Dim moji() As String, Cosu() As Integer, i As Integer
Dim myRange As Range, Most As String, ip As Integer
Application.Volatile
ReDim moji(データ.Count)
ReDim Cosu(データ.Count)
For Each myRange In データ
If myRange.Text <> "" Then
Do
If moji(i) = myRange.Text Then
Cosu(i) = Cosu(i) + 1
Exit Do
Else
If moji(i) = "" Then
moji(i) = myRange.Text
Cosu(i) = Cosu(i) + 1
Exit Do
End If
i = i + 1
End If
Loop
i = 0
End If
Next myRange
i = 1
Do
If Cosu(ip) <= Cosu(i) Then
If Cosu(ip) = Cosu(i) Then
Most = Most & "," & moji(i)
Else
ip = i
Most = ""
End If
End If
i = i + 1
Loop Until Cosu(i) = 0
InLarge = moji(ip) & Most & "(" & Cosu(ip) & ")"
End Function
この回答への補足
御回答ありがとうございます。
これは凄いですね(^^)
実際に使用してみたのですが、ユーザー関数として自由に使用できるので、いろいろな場面で使用することができそうです。
私以外の方でも、このような処理をしたいと思った方は是非使用してみた方が良いと思います。
このコードがどのように組まれているのか分かりませんが、知識があればこういうことも出来てしまうのですね。
今後も、いろいろと勉強したいと思います。
ありがとうございました。
No.7
- 回答日時:
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sheetname As String
sheetname = "Sheet1" 'この部分に対象となるワークシート名を入れてください。
If ActiveSheet.Name = sheetname Then
Call maxmoji
End If
End Sub
Private Sub maxmoji()
Dim gyou As Integer
Dim retsu As Integer
Dim countmoji(100, 4)
Dim mojishu As Integer
Dim cellchar As String
Dim seirinum As Integer
Dim i As Integer
Dim j As Integer
Const moji = 0
Const kazu = 1
Const leftbig = 2
Const rightbig = 3
Dim maxchar As String
Dim maxnum As Integer
Dim thiscount As Integer
gyou = Range("A1").End(xlDown).Row
retsu = Range("A1").End(xlToRight).Column
mojishu = 0
For i = 1 To gyou
For j = 1 To retsu
cellchar = Cells(i, j).Value
seirinum = 0
If mojishu = 0 Then
countmoji(0, moji) = cellchar
countmoji(0, kazu) = 1
mojishu = 1
Else
Do
If countmoji(seirinum, moji) = cellchar Then
countmoji(seirinum, kazu) = countmoji(seirinum, kazu) + 1
Exit Do
ElseIf countmoji(seirinum, moji) > cellchar Then
If countmoji(seirinum, leftbig) > 0 Then
seirinum = countmoji(seirinum, leftbig)
Else
countmoji(seirinum, leftbig) = mojishu
countmoji(mojishu, moji) = cellchar
countmoji(mojishu, kazu) = 1
mojishu = mojishu + 1
Exit Do
End If
Else
If countmoji(seirinum, rightbig) > 0 Then
seirinum = countmoji(seirinum, rightbig)
Else
countmoji(seirinum, rightbig) = mojishu
countmoji(mojishu, moji) = cellchar
countmoji(mojishu, kazu) = 1
mojishu = mojishu + 1
Exit Do
End If
End If
Loop
End If
Next
Next
maxnum = 0
For i = 0 To mojishu
thiscount = countmoji(i, kazu)
If thiscount > maxnum Then
maxnum = thiscount
maxchar = countmoji(i, moji)
ElseIf thiscount = maxnum Then
maxchar = maxchar & " , " & countmoji(i, moji)
End If
Next
Cells(gyou + 3, 1).Value = maxchar & "(" & maxnum & "個)"
End Sub
本当はnishi6さんみたいに関数を作ったほうがいいのですが僕にはああいう風にセルの範囲をしていたものを処理する技術がないので前に僕が作った関数を元に進めて生きたいとオみます。
ただし結果の表示場所はデータの範囲の最下列より二つ空けてその下に表示させるようにしました。あと、表示形式はnishi6さんと同じものにしました。
あと、マクロは標準モジュールを開いてそこに記入するのが普通なのですが今回のマクロはThisWorkbookの方にコピーしてください。
御回答ありがとうございます。
かなり長いコードですね。
わざわざ作成して頂き、ありがとうございます。
だんだんとマクロについて理解できるようになってきました(^^)
このコードの意味は今は分からないですが、今後の勉強材料としても使わせて頂きますね。
いろいろとありがとうございました。
No.5
- 回答日時:
ユーザー定義関数を作ってみました。
A5に式を入力してみて下さい。=maxNum_Chr("A1:B4","D2:D5","F1:K6") のように、調べる領域を必要なだけ指定します。
例えば、「あ」が9個で一番多ければ、あ(9個) と表示。
「あ」と「い」と「1」が3個で一番多ければ、あ,い,1(3個) と表示します。
Function maxNum_Chr(rg1, ParamArray rg2())
Dim cot As Long, cot2 As Long '2つ目以降のセル領域の個数
Dim rgArea As Range '結合したセル領域
Dim dt() As String 'セルの値を取り込む配列
Dim rg As Range 'セル
Application.Volatile
'飛び離れた領域を同一視するようにします
Set rgArea = Range(rg1)
If UBound(rg2) <> -1 Then
For cot = LBound(rg2) To UBound(rg2)
Set rgArea = Application.Union(rgArea, Range(rg2(cot)))
Next
End If
'セルの値を取り込みます
Dim num As Long 'データ個数
num = rgArea.Count
ReDim dt(num)
cot = 0
For Each rg In rgArea
cot = cot + 1: dt(cot) = rg.Text
Next
'セルの値を比較します
Dim chkDT As String
Dim nMAX As Integer, cCot As Integer
For cot = 1 To num
If dt(cot) <> "" Then
chkDT = dt(cot): cCot = 1
For cot2 = cot + 1 To num '個数をカウント
If chkDT = dt(cot2) Then
dt(cot2) = "": cCot = cCot + 1
End If
Next
If nMAX = cCot Then '最大個数が複数
maxNum_Chr = maxNum_Chr & "," & chkDT
ElseIf nMAX < cCot Then '最大は1つのみ
maxNum_Chr = chkDT: nMAX = cCot
End If
End If
Next
maxNum_Chr = maxNum_Chr & "(" & nMAX & "個)"
End Function
この回答への補足
いろいろと試してみましたが、「#NAME?」と表示されたり、「名前が適切ではありません」など表示されることもあります。
ん~、私にはもうお手上げな状態です。
アドバイスをよろしく御願いします。
nishi6さん、御回答ありがとうございます。
早速試してみたのですが、上手くいきません。
恐らくVB自体初めて扱うので、私の方に不備があると思いますが(ー_ー;
「プロジェクト エクスプローラ」を開き、表が入っているシートを選択しました。
すると、ウィンドウが開いたので、そこに教えて頂いたコードを記述して、閉じました。
上右のプルダウンで(General)となっていましたが、これはworksheetにしなくても良いんですよね?
そして、表に戻って適当なセルに教えて頂いた式を範囲を変えてから記述。
リターンしてみましたが、「#VALUE!」と表示されて上手くいっていないようです。
ブック自体を1度保存してから、再度開いた時にマクロを有効にするかどうか聞かれたので、有効にするを選択して、また実行してみましたがやはりできませんでした。
おそらく簡単なことができていないだけの事だと思いますが、アドバイスを頂けると助かります。
またこの処理を表の中のデータを変更しても、その都度自動に処理してくれるようにすることはできるでしょうか?
お手数をおかけ致しますが、よろしく御願いします。
No.4
- 回答日時:
3で説明を入れるのを忘れていたのでこっちに書きます。
最上列の左から連続して右側に連続してデータのあるところまでと最左列の一番上から連続してデータがあるところまでで囲まれた中で一番多い文字を導き出します。
同数があれば" , "でくぎって表示します。
でも表示する部分は固定なんですよね。
仕様ミスかな?
他にもバグがあるかもしれません。
こんばんは。
mousengokeさん、御回答ありがとうございます。
先程教えて頂いたコードを試してみたところ、上手くできました(^^)
実は今回が始めてVBAを触ってみるので、いろいろとサイトを調べて勉強してみました。
教えて頂いたコードを、「プロジェクト エクスプローラ」を開き、その中で実行したいシートの名前を開いて、そのまま記述するだけでいいんですよね?
あとは、マクロの実行を選ぶだけで処理はちゃんとできました。
もう1つできたらいいな、と思う事があるのですが、今回教えて頂いたマクロを常に実行できるようにはできるでしょうか?
例えば、表の入力されている内容を変更しても、自動的に処理されて抽出できるようにしたいのですが。
毎回マクロを実行するよりは、自動的に処理できると便利になりますので。
お手数をお掛けしますが、あともう少しアドバイスを頂けると嬉しく思います。
よろしく御願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(データベース) Accessのクエリで1フィールドの抽出条件設定をNullでなく全角半角含む空白のみの文字列でない文 1 2023/04/24 15:20
- Excel(エクセル) Indirect関数について、Formulatextで抽出した数式を参照したい。 1 2022/12/15 11:16
- Excel(エクセル) エクセルで2つの表を比較して、文字列が同じだが、その行のある値が違うものを抽出したい 1 2022/10/06 21:48
- Excel(エクセル) エクセルで重複データから重複を削除して指定の列に抽出したい 11 2022/05/11 11:26
- Excel(エクセル) エクセル関数の変わった使い方 3 2022/05/13 17:12
- Visual Basic(VBA) Sheet2からオートフィルターで売上日を抽出した件数をカウントし、その件数をSheet1のセルB1 2 2023/01/12 12:24
- Excel(エクセル) エクセルの数式で教えてください。 1 2023/06/15 14:11
- Excel(エクセル) エクセルで#以降の文字を取得したい 1 2022/03/28 13:14
- Excel(エクセル) 条件に合った数値の合計を表示させたい関数と条件指定の方法 3 2023/05/13 16:07
- その他(プログラミング・Web制作) プログラミング pythonの問題について 2 2022/04/19 00:41
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【Excel関数】UNIQUE関数で"0"...
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
excelのデータで色つき行の抽出...
-
エクセル マクロで数値が変っ...
-
AのセルとB行を比較して、一致...
-
結合されたセルをプルダウンの...
-
Excel グラフのプロットからデ...
-
エクセル 上下で列幅を変えるには
-
特定の文字がある行以外を削除...
-
excel 小さすぎて見えないセル...
-
エクセルVBA 最終行を選んで並...
-
エクセルVBA:リストに登録した...
-
エクセルで昨日までの日付デー...
-
エクセル 数字のみ残したい
-
VBAで色の付いているセルの行削除
-
エクセル2016で時間を入力して...
-
Excelでカタカナ・ひらがな・英...
-
電話番号の入力方式が違うデー...
-
罫線の斜線を自動で引くマクロ
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
[EXCEL]ボタン押す→時刻が表に...
-
結合されたセルをプルダウンの...
-
エクセル マクロで数値が変っ...
-
Excel グラフのプロットからデ...
-
AのセルとB行を比較して、一致...
-
エクセル 上下で列幅を変えるには
-
Excel ウインドウ枠の固定をす...
-
特定の文字がある行以外を削除...
-
excelのデータで色つき行の抽出...
-
エクセル2016で時間を入力して...
-
excel 小さすぎて見えないセル...
-
EXCELで最後の行を固定
-
エクセルVBA 最終行を選んで並...
-
VBAで色の付いているセルの行削除
-
エクセルマクロで偶数行(又は...
-
エクセルのセルに指定画像(.jpg...
-
罫線の斜線を自動で引くマクロ
おすすめ情報