Excel VBA質問箱 IV

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

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


68832 / 76734 ←次へ | 前へ→

【12428】Re:再チャレンジ!
発言  ni  - 04/4/2(金) 21:47 -

引用なし
パスワード
   つんさん、みなさん、こんばんは

配列数式を使う方法を最近おぼえたので作ってみました。

結果を書き出す範囲を選択して、数式バーに
=mySub(A5:A8,A15:A17)
のようにキーインして、Ctrl+Shift+Enter で配列数式として入力して下さい。

Option Explicit

'配列数式で与える
Function mySub(argR1 As Range, argR2 As Range) As Variant
'argR1 : 数えたいカテゴリの数字あるいは「N」
'argR2 : カウントする範囲
Dim kensakuti As Variant
Dim hanni As Variant
Dim ans As Variant
Dim tbl() As String
Dim e3 As Variant
Dim i As Long, j As Long, k As Long
Dim n As Long
Dim ncount As Long, q As String

kensakuti = argR1.Value
hanni = argR2.Value

If Right$(TypeName(kensakuti), 1) = ")" Then  '複数セル
  ReDim ans(LBound(kensakuti, 1) To UBound(kensakuti, 1), _
      LBound(kensakuti, 2) To UBound(kensakuti, 2))
End If

'カウントする範囲のデータをバラバラにして、tbl()に記憶
n = 0
For i = LBound(hanni, 1) To UBound(hanni, 1)
  For j = LBound(hanni, 2) To UBound(hanni, 2)
    e3 = Split(CStr(hanni(i, j)), ",")
    ReDim Preserve tbl(n + UBound(e3) + 1)
    For k = 0 To UBound(e3)
      tbl(n + k) = CStr(e3(k))
    Next
    n = n + UBound(e3) + 1
  Next
Next

For i = LBound(kensakuti, 1) To UBound(kensakuti, 1)
  For j = LBound(kensakuti, 2) To UBound(kensakuti, 2)
    q = kensakuti(i, j)
    ncount = 0
    For k = 0 To n
      ncount = ncount + IIf(tbl(k) = q, 1, 0)
    Next
    ans(i, j) = ncount
  Next
Next

mySub = ans

End Function

セル参照は2回+書き出しに1回だけなので、ひょっとすると速いかも。
0 hits

【12115】ユーザー定義関数について つん 04/3/24(水) 12:57 質問
【12119】Re:ユーザー定義関数について Jaka 04/3/24(水) 13:56 発言
【12120】Re:ユーザー定義関数について こうちゃん 04/3/24(水) 14:18 発言
【12124】Re:ユーザー定義関数について つん 04/3/24(水) 14:32 発言
【12138】自動再計算をやめて・・・ つん 04/3/24(水) 19:30 お礼
【12160】Re:ユーザー定義関数について つん 04/3/25(木) 15:07 お礼
【12176】Re:ユーザー定義関数について 角田 04/3/25(木) 18:47 回答
【12187】Re:ユーザー定義関数について つん 04/3/26(金) 9:19 発言
【12410】再チャレンジ! つん 04/4/2(金) 16:15 質問
【12415】Re:再チャレンジ! Jaka 04/4/2(金) 17:17 発言
【12464】やっぱ違ってた。 Jaka 04/4/5(月) 13:04 発言
【12465】え?どこが? つん 04/4/5(月) 13:31 お礼
【12466】忘れてた・・・・ つん 04/4/5(月) 13:44 発言
【12470】Re:忘れてた・・・・ Jaka 04/4/5(月) 16:00 発言
【12416】Re:再チャレンジ! 角田 04/4/2(金) 17:21 回答
【12428】Re:再チャレンジ! ni 04/4/2(金) 21:47 発言
【12474】検証中 つん 04/4/5(月) 16:40 お礼
【12476】Re:検証中 ni 04/4/5(月) 17:34 発言
【12479】ああああ!(>_<) つん 04/4/5(月) 19:11 発言
【12484】出来ました! つん 04/4/6(火) 9:34 お礼
【12467】Re:再チャレンジ! つん 04/4/5(月) 13:47 お礼
【12469】Re:再チャレンジ! 角田 04/4/5(月) 14:46 回答
【12472】Re:再チャレンジ! つん 04/4/5(月) 16:34 お礼

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