accessで最小公倍数を求める

質問

ACCESSで最小公倍数を求めた値をセットしたいのです

データとしては
キー項目 数値
A　　　　　２
A　　　　　３
Ａ　　　　　２
Ｂ　　　　　１
Ｂ　　　　　３
Ｃ　　　　　２
とあったとしてキー項目単位で求めた最小公倍数をセットしたデータを
ｕｐｄａｔｅしたいのです
キー項目　数値　最小公倍数
A　　　　　２　　　　　６
A　　　　　３　　　　　６
Ａ　　　　　２　　　　　６
Ｂ　　　　　１　　　　　３
Ｂ　　　　　３　　　　　３
Ｃ　　　　　２　　　　　２

このような更新クエリーを作りたいのですが
最小公倍数の関数がＥＸＣＥＬならＬＣＭというのがあるみたいですが
ＡＣＣＥＳＳには見つからなかったので・・・
データが大量にあるのでＡＣＣＥＳＳで処理したいのですが
いい方法がありましたらアドバイス下さい

回答No.2

piroin654 · ベストアンサー

No1の訂正です。
＞一応、数値が0であったり、抜けている場合は無視するように
＞しています。
の処理が不十分なコードを載せていました。以下のようにしてください。

Sub cmdxy()
　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim varArray() As Variant
　　Dim i As Long
　　Dim j As Long
　　Dim lnNum As Long

　　Set db = CurrentDb
　　Set rs1 = db.OpenRecordset("テーブル1", dbOpenDynaset)
　　Set rs2 = db.OpenRecordset("Qキー項目")

　　rs2.MoveFirst
　　Do Until rs2.EOF
　　　　'カウンタ、及び配列の初期化
　　　　i = 0
　　　　ReDim Preserve varArray(0)

　　　　'データの取込
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　If rs1!キー項目 = rs2!キー項目 Then
　　　　　　　　If IsNull(rs1!数値) Or rs1!数値 = 0 Then
　　　　　　　　'何もしません
　　　　　　　　Else
　　　　　　　　　　varArray(i) = rs1!数値
　　　　　　　　　　ReDim Preserve varArray(UBound(varArray) + 1)
　　　　　　　　　　i = i + 1
　　　　　　　　End If
　　　　　　End If
　　　　　　rs1.MoveNext
　　　　Loop

　　　　'最小公倍数の計算
　　　　lnNum = varArray(0)
　　　　For j = 0 To UBound(varArray) - 1
　　　　　　lnNum = funcLCM(lnNum, varArray(j))
　　　　Next

　　　　'最小公倍数の書き込み
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　If rs1!キー項目 = rs2!キー項目 Then
　　　　　　　　If IsNull(rs1!数値) Or rs1!数値 = 0 Then
　　　　　　　　'何もしません
　　　　　　　　Else
　　　　　　　　　　rs1.Edit
　　　　　　　　　　rs1!最小公倍数 = lnNum
　　　　　　　　　　rs1.Update
　　　　　　　　End If
　　　　　　End If
　　　　　　rs1.MoveNext
　　　　Loop
　　　　Erase varArray
　　　　rs2.MoveNext
　　　　Loop

　　rs1.Close: Set rs1 = Nothing
　　rs2.Close: Set rs2 = Nothing
　　db.Close: Set db = Nothing
End Sub

No1の関数、およびこのプロシージャを
標準モジュールに保存し、No1での使用方法で
実行してみてください。

回答No.3

30246kiku

解決されていない認識で良かったでしょうか、
piroin654 さんと変わり映えしませんが回答してみます。

元々のテーブル名を「TC」と仮定します。
以下を標準モジュールに記述しておきます。

Public Function TCLCM(vCode As Variant) As Long
　　Dim rs As New ADODB.Recordset
　　Dim iNum As Long, i As Long, j As Long, iTmp As Long

　　iNum = 0
　　rs.Source = "SELECT 数値 FROM TC WHERE 項目='" & vCode & "';"
　　rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
　　Do While (Not rs.EOF)
　　　　If (IsNull(rs(0))) Then
　　　　　　iNum = 0
　　　　　　Exit Do
　　　　ElseIf (rs(0) < 1) Then
　　　　　　iNum = 0
　　　　　　Exit Do
　　　　End If
　　　　i = rs(0)
　　　　If (iNum = 0) Then
　　　　　　iNum = i
　　　　Else
　　　　　　j = iNum
　　　　　　While (i)
　　　　　　　　iTmp = j Mod i
　　　　　　　　j = i
　　　　　　　　i = iTmp
　　　　　　Wend
　　　　　　iNum = iNum * rs(0) \ j
　　　　End If
　　　　rs.MoveNext
　　Loop
　　rs.Close
　　TCLCM = iNum
End Function

クエリは何種類かあって、表示上だけであれば

1) 更新/追加（項目・数値）したい場合

SELECT 項目, 数値, TCLCM(項目) AS 最小公倍数
FROM TC;

2) 単に表示すれば良い場合

SELECT Q1.項目, Q1.数値, Q2.最小公倍数
FROM TC AS Q1 INNER JOIN
(SELECT 項目, TCLCM(項目) AS 最小公倍数 FROM TC GROUP BY 項目) AS Q2
ON Q1.項目 = Q2.項目;

2) の方が作った関数を呼ぶ回数が少ないので速いかも・・・・

テーブル「TC」のフィールド「最小公倍数」に値を設定する場合

UPDATE TC SET 最小公倍数 = TCLCM(項目);

※ 「キー項目」という項目名は、面倒だったので「項目」にしていました。

※ 処理性能はわかりません。参考にする/しない等々自己責任にてお願いします。

お礼

ありがとうございます
こんな方法もあるのですね
勉強になります

回答No.1

piroin654

誰かが回答すると思っていたのですが・・・・。
Excelの最小公倍数を求める関数をAccessから利用する
方法は以下にあります。
http://support.microsoft.com/kb/198571/ja
そこでこの関数が役に立つか確認したところ、
1　反応がものすごく遅い。およそ1秒かかる。
2　0を入れると最小公倍数が0で返ってくる。
1は一回きりの計算ならば、気長に待てばいいかもしれません。
2はデータの取得の方法を工夫すればいいのかもしれません。
で、更新クエリなんぞでこの関数を利用した方法が可能か
考えてみましたが、大風邪の真っ最中なので思考停止。
あっさりVBAでグリグリ行く方法を載っけます。

まず、クエリを一つ。これはキー項目の名寄せをします。
Qキー項目
という名前で保存してください。テーブル名は実際に合わせて
変更してください。

SELECT テーブル1.キー項目
FROM テーブル1
GROUP BY テーブル1.キー項目;

以下は標準モジュールに。

最大公約数と最小公倍数を求める関数を。
比較する数値の個数がキー項目ごとに変動
するようなので少し工夫が必要ですが。

Private Function funcGCM(ByVal x As Long, Optional ByVal y As Long) As Long
　　If y = 0 Or IsNull(y) Then
　　　　funcGCM = x
　　Else
　　　　funcGCM = funcGCM(y, x Mod y)
　　End If
End Function

Function funcLCM(ByVal x As Long, ByVal y As Long) As Long
　　funcLCM = x * y / funcGCM(x, y)
End Function

次に、実行するプロシージャを。コード中のテーブル名は実際に
合わせて変更してください。
一応、数値が0であったり、抜けている場合は無視するように
しています。

Sub cmdxy()
　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim varArray() As Variant
　　Dim i As Long
　　Dim j As Long
　　Dim lnNum As Long

　　Set db = CurrentDb
　　Set rs1 = db.OpenRecordset("テーブル1", dbOpenDynaset)
　　Set rs2 = db.OpenRecordset("Qキー項目")

　　rs2.MoveFirst
　　Do Until rs2.EOF
　　　　'カウンタ、及び配列の初期化
　　　　i = 0
　　　　ReDim Preserve varArray(0)

　　　　'データの取込
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　If rs1!キー項目 = rs2!キー項目 Then
　　　　　　　　If Not IsNull(rs1!数値) Or Not rs1!数値 = 0 Then
　　　　　　　　　　varArray(i) = rs1!数値
　　　　　　　　　　ReDim Preserve varArray(UBound(varArray) + 1)
　　　　　　　　　　i = i + 1
　　　　　　　　End If
　　　　　　　　End If
　　　　　　rs1.MoveNext
　　　　Loop

　　　　'最小公倍数の計算
　　　　lnNum = varArray(0)
　　　　For j = 0 To UBound(varArray) - 1
　　　　　　lnNum = funcLCM(lnNum, varArray(j))
　　　　Next

　　　　'最小公倍数の書き込み
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　If rs1!キー項目 = rs2!キー項目 Then
　　　　　　　　If Not IsNull(rs1!数値) Or Not rs1!数値 = 0 Then
　　　　　　　　　　rs1.Edit
　　　　　　　　　　rs1!最小公倍数 = lnNum
　　　　　　　　　　rs1.Update
　　　　　　　　End If
　　　　　　End If
　　　　　　rs1.MoveNext
　　　　Loop
　　　　Erase varArray
　　　　rs2.MoveNext
　　　　Loop

　　rs1.Close: Set rs1 = Nothing
　　rs2.Close: Set rs2 = Nothing
　　db.Close: Set db = Nothing
End Sub

なお、DAOを使っているので、コード表のツール→参照設定で
Microsoft DAO xx Object Library
にチェックを入れてください。xxは3.6のような数字です。

使用法は、cmdxyをイミディエイトウィンドウで実行するか、
あるいは、フォームのボタンクリックで、

Call cmdxy

とするかです。

わからないところがあれば補足してください。

お礼

ありがとうございます
手作業で計算しなきゃ・・・とあきらめるところでしたが
無事大量データを短時間で処理する事ができました