Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3991 / 13655 ﾂﾘｰ

←次へ　｜　前へ→

▼

【59047】数値を大きい順に順位を割り当てる方法について まさる 08/11/24(月) 21:06

【59050】Re:数値を大きい順に順位を割り当てる方法... かみちゃん 08/11/24(月) 22:33

【59051】Re:数値を大きい順に順位を割り当てる方法... ponpon 08/11/24(月) 22:39

【59052】Re:数値を大きい順に順位を割り当てる方法... aaa 08/11/24(月) 22:40

【59061】Re:数値を大きい順に順位を割り当てる方法... Hirofumi 08/11/25(火) 19:55

【59064】Re:数値を大きい順に順位を割り当てる方法... Hirofumi 08/11/25(火) 21:21

【59065】Re:数値を大きい順に順位を割り当てる方法... まさる 08/11/26(水) 1:46

【59077】Re:数値を大きい順に順位を割り当てる方法... まさる 08/11/26(水) 22:04

【59078】Re:数値を大きい順に順位を割り当てる方法... かみちゃん 08/11/26(水) 22:28

【59079】Re:数値を大きい順に順位を割り当てる方法... Hirofumi 08/11/26(水) 22:43

【59080】Re:数値を大きい順に順位を割り当てる方法... まさる 08/11/26(水) 23:08


	【59047】数値を大きい順に順位を割り当てる方法に...

まさる - 08/11/24(月) 21:06 -


	引用なし

	パスワード

ユーザー定義関数でA,B,C,Dの変数に収めてある数値を、大きい順に A & B & C & D と言う風に出力する定義関数を作りたいと考えているのですが、2つ3つならIF文で順番をつけていけますが、処理変数が多くなると、手間がかかってしかたありません。　もし良い方法をご存知の方がおましたら、アドバイスをどうかよろしくお願いします。


	【59050】Re:数値を大きい順に順位を割り当てる方...

かみちゃん

- 08/11/24(月) 22:33 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。

>ユーザー定義関数でA,B,C,Dの変数に収めてある数値を、大きい順に A & B & C & D と言う風に出力する定義関数を作りたい

以下のような感じのことがしたいのでしょうか？

定義関数の名前がいいのが思いつきませんでしたので、func1という名前にしています(^^;

Sub Sample()
　Dim intA As Integer
　Dim intB As Integer
　Dim intC As Integer
　Dim intD As Integer
　
　intA = 4
　intB = 3
　intC = 2
　intD = 1
　
　MsgBox func1(Array(intA, intB, intC, intD))

End Sub

Function func1(vntData As Variant) As String
　Dim i As Integer
　Dim strData As String
　
　For i = 1 To UBound(vntData) + 1
　　If strData <> "" Then
　　　strData = strData & "&"
　　End If
　　strData = strData & Application.WorksheetFunction.Large(vntData, i)
　Next
　
　func1 = strData
End Function


	【59051】Re:数値を大きい順に順位を割り当てる方...

ponpon - 08/11/24(月) 22:39 -


	引用なし

	パスワード

▼まさるさん：
>ユーザー定義関数でA,B,C,Dの変数に収めてある数値を、大きい順に A & B & C & D と言う風に出力する定義関数を作りたいと考えているのですが、2つ3つならIF文で順番をつけていけますが、処理変数が多くなると、手間がかかってしかたありません。　もし良い方法をご存知の方がおましたら、アドバイスをどうかよろしくお願いします。

ソートするには、いろいろと方法があるようです。
参考になれば・・・

ht tp://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800.html


	【59052】Re:数値を大きい順に順位を割り当てる方...

aaa - 08/11/24(月) 22:40 -


	引用なし

	パスワード

並べ替えの話ですね。
「ソート」で検索してみてください。
アルゴリズムは沢山あるので好きなのでいいと思います。
最初は「バブルソート」あたりが分かりやすいですかね？


	【59061】Re:数値を大きい順に順位を割り当てる方...

Hirofumi - 08/11/25(火) 19:55 -


	引用なし

	パスワード

ShellSortを使った例です

Option Explicit

Sub Main()

　　Dim vntA As Variant
　　Dim vntB As Variant
　　Dim vntC As Variant
　　Dim vntD As Variant

　　vntA = 1
　　vntB = 2
　　vntC = 3
　　vntD = 4

　　MsgBox GetList(vntA, vntB, vntC, vntD)

End Sub

Private Function GetList(ParamArray vntData() As Variant) As String

　　Dim i As Long
　　Dim strData As String
　　Dim vntSort As Variant
　　
　　vntSort = vntData
　　
　　ShellSort vntSort
　　
　　For i = 0 To UBound(vntSort)
　　　　If strData <> "" Then
　　　　　　strData = strData & "&"
　　　　End If
　　　　strData = strData & vntSort(i)
　　Next i

　　GetList = strData
　
End Function

Private Sub ShellSort(vntList As Variant)

　　Dim i As Long
　　Dim j As Long
　　Dim lngGap As Long
　　Dim vntTmp As Variant
　　Dim lngTop As Long
　　Dim lngEnd As Long
　　
　　lngTop = LBound(vntList)
　　lngEnd = UBound(vntList)
　　
　　lngGap = 1
　　Do While lngGap < (lngEnd - lngTop + 1) \ 3
　　　　lngGap = 3 * lngGap + 1
　　Loop
　　
　　Do Until lngGap <= 0
　　　　For i = lngGap + lngTop To lngEnd
　　　　　　vntTmp = vntList(i)
　　　　　　For j = i To lngGap + lngTop Step -lngGap
　　　　　　　　If vntList(j - lngGap) >= vntTmp Then
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　　　vntList(j) = vntList(j - lngGap)
　　　　　　Next j
　　　　　　vntList(j) = vntTmp
　　　　Next i
　　　　lngGap = lngGap \ 3
　　Loop

End Sub


	【59064】Re:数値を大きい順に順位を割り当てる方...

Hirofumi - 08/11/25(火) 21:21 -


	引用なし

	パスワード

「数値を大きい順に順位を割り当てる方法に」？とは、
もしかすると、Rankを割り当てる此方の方？

Option Explicit

Sub Main_2()

　　Dim vntA As Variant
　　Dim vntB As Variant
　　Dim vntC As Variant
　　Dim vntD As Variant

　　vntA = 1
　　vntB = 2
　　vntC = 2
　　vntD = 4

　　MsgBox GetRank(vntA, vntB, vntC, vntD)

End Sub

Private Function GetRank(ParamArray vntData() As Variant) As String

　　Dim i As Long
　　Dim strData As String
　　Dim vntSort As Variant
　　Dim lngIndex() As Long
　　Dim lngRank As Long
　　
　　vntSort = vntData
　　
　　ReDim lngIndex(UBound(vntData))
　　For i = 0 To UBound(vntData)
　　　　lngIndex(i) = i
　　Next i
　　
　　ShellSort vntSort, lngIndex
　　
　　lngRank = 1
　　vntSort(lngIndex(0)) = lngRank
　　For i = 1 To UBound(vntSort)
　　　　If vntData(lngIndex(i)) <> vntData(lngIndex(i - 1)) Then
　　　　　　lngRank = i + 1
　　　　End If
　　　　vntSort(lngIndex(i)) = lngRank
　　Next i
　　
　　For i = 0 To UBound(vntSort)
　　　　If strData <> "" Then
　　　　　　strData = strData & "&"
　　　　End If
　　　　strData = strData & vntSort(i)
　　Next i

　　GetRank = strData
　
End Function

Private Sub ShellSort(vntList As Variant, _
　　　　　　　　　　lngIndex() As Long)

　　Dim i As Long
　　Dim j As Long
　　Dim lngGap As Long
　　Dim lngTmp As Long
　　Dim lngTop As Long
　　Dim lngEnd As Long
　　
　　lngTop = LBound(lngIndex, 1)
　　lngEnd = UBound(lngIndex, 1)
　　
　　lngGap = 1
　　Do While lngGap < (lngEnd - lngTop + 1) \ 3
　　　　lngGap = 3 * lngGap + 1
　　Loop
　　
　　Do Until lngGap <= 0
　　　　For i = lngGap + lngTop To lngEnd
　　　　　　For j = i To lngGap + lngTop Step -lngGap
　　　　　　　　If vntList(lngIndex(j - lngGap)) <= vntList(lngIndex(j)) Then
　　　　　　　　　　lngTmp = lngIndex(j - lngGap)
　　　　　　　　　　lngIndex(j - lngGap) = lngIndex(j)
　　　　　　　　　　lngIndex(j) = lngTmp
　　　　　　　　Else
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next j
　　　　Next i
　　　　lngGap = lngGap \ 3
　　Loop

End Sub


	【59065】Re:数値を大きい順に順位を割り当てる方...

まさる - 08/11/26(水) 1:46 -


	引用なし

	パスワード

みさなん、貴重のアイディアありがとうございます。
今拝見しましたが、ちょっとレベル高いですね（汗
理解するのに時間がかかりそうなので、また改めて
お礼を投稿させてもらいます。　ありがとうございます。


	【59077】Re:数値を大きい順に順位を割り当てる方...

まさる - 08/11/26(水) 22:04 -


	引用なし

	パスワード

すいません、ちょっと仕様が違うようです。
あるシートに数字のデータがありましたて、
そのデータを元にユーザー定義関数内である計算を複数件施しまして、その結果を収めてた変数の大きい順に以下のﾃｽﾄマクロのような形で作りたいと考えています。　以下のマクロの計算式自体には深い意味はないでが、出力する際の出力表示形式が下の用にしたいと思っています。A,B,C,Dを大小比較して、もう一度違う変数に入れなおす形になると思うのですが、そこの大小比較の手順が理解できないです。

Function ﾃｽﾄ(範囲 As RANGE)

A= WorksheetFunction.StDev(範囲.Cells(1, 1).Resize(, 10))
B= WorksheetFunction.StDev(範囲.Cells(1, 1).Resize(, 20))
C= WorksheetFunction.StDev(範囲.Cells(1, 1).Resize(, 30))
D= WorksheetFunction.StDev(範囲.Cells(1, 1).Resize(, 30))

ﾃｽﾄ = A &　"/" & B & "/" & C & "/" & D 'ここでは例としてA>B>C>Dとします。

End Function


	【59078】Re:数値を大きい順に順位を割り当てる方...

かみちゃん

- 08/11/26(水) 22:28 -


	引用なし

	パスワード

こんにちは。かみちゃん　です。

> ちょっと仕様が違うようです。

他の方から、いろいろ提案されているのですが、私が[59050]で提示したコード
では、条件を満たしていませんか？

そもそも、間違っているなら、ご指摘いただけないでしょうか？

なお、[59050]では、
4&3&2&1
という結果が表示されるのですが、
4/3/2/1
と表示したいということではないのでしょうか？

それであれば、
　　　strData = strData & "&"
の部分を
　　　strData = strData & "/"
とするだけなのですが・・・


	【59079】Re:数値を大きい順に順位を割り当てる方...

Hirofumi - 08/11/26(水) 22:43 -


	引用なし

	パスワード

それなら、こんなかな？

Option Explicit

Sub Main_3()

　　MsgBox GetList(Worksheets("Sheet1").Cells(3, "C").Resize(3, 3))

End Sub

Public Function GetList(rngData As Range) As String

　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim lngRows As Long
　　Dim lngColumns As Long
　　Dim vntData As Variant
　　Dim strData As String
　　Dim vntSort As Variant
　　
　　With rngData
　　　　lngRows = .Rows.Count
　　　　lngColumns = .Columns.Count
　　　　If lngRows = 1 And lngColumns = 1 Then
　　　　　　ReDim vntData(1 To 1, 1 To 1)
　　　　　　vntData(1, 1) = rngData.Value
　　　　Else
　　　　　　vntData = rngData.Value
　　　　End If
　　End With
　　
　　ReDim vntSort(lngRows * lngColumns - 1)
　　For i = 1 To lngRows
　　　　For j = 1 To lngColumns
　　　　　　vntSort(k) = vntData(i, j)
　　　　　　k = k + 1
　　　　Next j
　　Next i
　　
　　ShellSort vntSort
　　
　　For i = 0 To UBound(vntSort)
　　　　If strData <> "" Then
　　　　　　strData = strData & "/"
　　　　End If
　　　　strData = strData & vntSort(i)
　　Next i

　　GetList = strData
　
End Function

Private Sub ShellSort(vntList As Variant)

　　Dim i As Long
　　Dim j As Long
　　Dim lngGap As Long
　　Dim vntTmp As Variant
　　Dim lngTop As Long
　　Dim lngEnd As Long
　　
　　lngTop = LBound(vntList)
　　lngEnd = UBound(vntList)
　　
　　lngGap = 1
　　Do While lngGap < (lngEnd - lngTop + 1) \ 3
　　　　lngGap = 3 * lngGap + 1
　　Loop
　　
　　Do Until lngGap <= 0
　　　　For i = lngGap + lngTop To lngEnd
　　　　　　vntTmp = vntList(i)
　　　　　　For j = i To lngGap + lngTop Step -lngGap
　　　　　　　　If vntList(j - lngGap) >= vntTmp Then
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　　　vntList(j) = vntList(j - lngGap)
　　　　　　Next j
　　　　　　vntList(j) = vntTmp
　　　　Next i
　　　　lngGap = lngGap \ 3
　　Loop

End Sub


	【59080】Re:数値を大きい順に順位を割り当てる方...

まさる - 08/11/26(水) 23:08 -


	引用なし

	パスワード

すいません、ちょっと読んで、難しかったので流し読みしてしまいました。
かみちゃんさんのマクロは何とか今しがた理解できました。
ご指摘通り、十分に私のやりたい事満たしていました。
適当に回答してすいませんでした。（汗

Hirofumiさんのマクロはちょっと読んでみたのですが、何をしているのか理解できていない状態です。もう少し、考えてみればわかるかもしれないのでもう少し考えてみたいと思います。わからなければ質問させてもらうかもしれませんので、その際はよろしくお願いします。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3991 / 13655 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free