Excel VBA質問箱 IV

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

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


3980 / 13644 ツリー ←次へ | 前へ→

【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:数値を大きい順に順位を割り当てる方...
発言  かみちゃん E-MAIL  - 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:数値を大きい順に順位を割り当てる方...
発言  かみちゃん E-MAIL  - 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さんのマクロはちょっと読んでみたのですが、何をしているのか理解できていない状態です。もう少し、考えてみればわかるかもしれないのでもう少し考えてみたいと思います。わからなければ質問させてもらうかもしれませんので、その際はよろしくお願いします。

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