Excelマクロで六星占術の運気を占う

前回は、六星占術をオススメするべく、六星占術が統計学であることや、運命・宿命などの概要をお伝えしました。今回は、実際の六星占術の活用方法の一例として、Excelマクロ（VBA）を用いたマクロの紹介や、その応用例をご紹介したいと思います。

こんな方におすすめ

六星占術があたると思った方
六星占術を使い倒してみたくなったという方

前回の記事

ゆーはち茶飯事

六星占術のススメ：統計学だからあたる

https://puusenkou.com/statistics

皆さん、占いを信じますか？私は、モノによって信じます。ではどんなものを信じるか？というと、統計学を元に成り立っている占いです。私は細木数子氏の六星占術に2002年頃にはまりました。何故かというと、六星占術は統計学の要素を含んでいるからです。統計学と聞くと、信頼性が一気に上がるイメージがありますよね。私がこの六星占術を知ってから10数年経つ中で、500人以上の方の占いをしてきました。個人的な感覚としては結構当たっていました。なかなかに的中率が高い占いだと思っている為、パートナー選びや、組織編制の一工夫、...

Excelの中で六星占術の運気を占う

六星占術を統計で使おうと思うと、如何に手軽に運命星や運気の抽出が出来るかがポイントになります。単体で扱う場合はこういったサイトを使えばよいですが、本格的に六星占術を活かそうと思うと、次のような対象を表形式で占いをしたくなると思います。

占いたい対象

・人に対しての複数日に渡った占い結果の閲覧
・複数人に対する占い結果の閲覧

この用途で利活用をする為には、Excelが便利です。ロジックは適当ですが、私が六星占術がExcel表で算出出来るようにマクロを作成しましたので、ご紹介します。

運命星、運気判定用のマクロ紹介

マクロ（VBA）のコード

まずは、次のコードをVBAのモジュールにコピーペーストしてください。

'年月日が全て「亥」の日'
Private Const baseDate As Date = #11/22/2019#
'運命星の列挙体'
Private Enum Unmei
    DoPlus
    DoMinus
    kinPlus
    kinMinus
    KaPlus
    KaMinus
    TenPlus
    TenMinus
    MokuPlus
    MokuMinus
    SuiPlus
    SuiMinus
End Enum

'運命判定関数'
Public Function GetUnmeiSei(ByVal 生年月日 As Variant) As String
    Dim DayDiff As Integer: DayDiff = DateDiff("d", baseDate, 生年月日) Mod 60 + 1
    Dim YearDiff As Integer: YearDiff = DateDiff("yyyy", baseDate, 生年月日) Mod 12 + 1
    Dim ReigoFlg As Boolean: ReigoFlg = False
    Dim PlusKbn As Integer: PlusKbn = Abs(DateDiff("yyyy", birthDay, 生年月日) Mod 2)
    Dim un As Unmei
    If IsEmpty(生年月日) Then Exit Function
    DayDiff = DayDiff - 1
    If DayDiff <= 0 Then DayDiff = DayDiff + 60
    If YearDiff <= 0 Then YearDiff = YearDiff + 12
    If PlusKbn = 1 Then
        Select Case DayDiff
            Case 1 To 10: un = DoPlus
            Case 11 To 20: un = kinPlus
            Case 21 To 30: un = KaPlus
            Case 31 To 40: un = TenPlus
            Case 41 To 50: un = MokuPlus
            Case 51 To 60: un = SuiPlus
        End Select
    Else
        Select Case DayDiff
            Case 1 To 10: un = DoMinus
            Case 11 To 20: un = kinMinus
            Case 21 To 30: un = KaMinus
            Case 31 To 40: un = TenMinus
            Case 41 To 50: un = MokuMinus
            Case 51 To 60: un = SuiMinus
        End Select
    End If
    Select Case un
        Case DoPlus: GetUnmeiSei = "土星人＋": If YearDiff = 12 Then ReigoFlg = True
        Case DoMinus: GetUnmeiSei = "土星人‐": If YearDiff = 1 Then ReigoFlg = True
        Case SuiPlus: GetUnmeiSei = "水星人＋": If YearDiff = 2 Then ReigoFlg = True
        Case SuiMinus: GetUnmeiSei = "水星人‐": If YearDiff = 3 Then ReigoFlg = True
        Case MokuPlus: GetUnmeiSei = "木星人＋": If YearDiff = 4 Then ReigoFlg = True
        Case MokuMinus: GetUnmeiSei = "木星人‐": If YearDiff = 5 Then ReigoFlg = True
        Case TenPlus: GetUnmeiSei = "天王星人＋": If YearDiff = 6 Then ReigoFlg = True
        Case TenMinus: GetUnmeiSei = "天王星人‐": If YearDiff = 7 Then ReigoFlg = True
        Case KaPlus: GetUnmeiSei = "火星人＋": If YearDiff = 8 Then ReigoFlg = True
        Case KaMinus: GetUnmeiSei = "火星人‐": If YearDiff = 9 Then ReigoFlg = True
        Case kinPlus: GetUnmeiSei = "金星人＋": If YearDiff = 10 Then ReigoFlg = True
        Case kinMinus: GetUnmeiSei = "金星人‐": If YearDiff = 11 Then ReigoFlg = True
    End Select
    If ReigoFlg = True Then GetUnmeiSei = GetUnmeiSei & "（霊合）"
End Function

'年運算出関数'
Public Function GetYearUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String
    Dim dDiff As Integer
    dDiff = DateDiff("yyyy", baseDate, 占い対象日) Mod 12 + 1
    GetYearUnmei = CalcUnmei(運命星, 占い対象日, dDiff)
End Function

'月運算出関数'
Public Function GetMonthUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String
    Dim dDiff As Integer
    dDiff = DateDiff("m", baseDate, 占い対象日) Mod 12 + 1
    GetMonthUnmei = CalcUnmei(運命星, 占い対象日, dDiff)
End Function

'日運算出関数'
Public Function GetDayUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String
    Dim dDiff As Integer
    dDiff = DateDiff("d", baseDate, 占い対象日) Mod 12 + 1
    GetDayUnmei = CalcUnmei(運命星, 占い対象日, dDiff)
End Function

'運気計算'
Private Function CalcUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant, ByVal dDiff As Variant) As String
    '霊合判定'
    Dim ReigoFlg As Boolean: ReigoFlg = False
    If InStr(運命星, "霊合") > 0 Then ReigoFlg = True
    
    '運気判定'
    If dDiff <= 0 Then dDiff = dDiff + 12
    Select Case dDiff
        Case 1: 規定数 = 12
        Case 2: 規定数 = 1
        Case 3: 規定数 = 2
        Case 4: 規定数 = 3
        Case 5: 規定数 = 4
        Case 6: 規定数 = 5
        Case 7: 規定数 = 6
        Case 8: 規定数 = 7
        Case 9: 規定数 = 8
        Case 10: 規定数 = 9
        Case 11: 規定数 = 10
        Case 12: 規定数 = 11
    End Select
    Select Case Replace(運命星, "（霊合）", "")
        Case "土星人＋": 規定数 = 規定数 + 1
        Case "土星人‐": 規定数 = 規定数
        Case "水星人＋": 規定数 = 規定数 + 11
        Case "水星人‐": 規定数 = 規定数 + 10
        Case "木星人＋": 規定数 = 規定数 + 9
        Case "木星人‐": 規定数 = 規定数 + 8
        Case "天王星人＋": 規定数 = 規定数 + 7
        Case "天王星人‐": 規定数 = 規定数 + 6
        Case "火星人＋": 規定数 = 規定数 + 5
        Case "火星人‐": 規定数 = 規定数 + 4
        Case "金星人＋": 規定数 = 規定数 + 3
        Case "金星人‐": 規定数 = 規定数 + 2
    End Select
    
    規定数 = 規定数 Mod 12
    If 規定数 <= 0 Then 規定数 = 規定数 + 12
    Select Case 規定数
        Case 2: CalcUnmei = "種子" & IIf(ReigoFlg = True, "/再会", "")
        Case 3: CalcUnmei = "緑生" & IIf(ReigoFlg = True, "/財政", "")
        Case 4: CalcUnmei = "立花" & IIf(ReigoFlg = True, "/安定", "")
        Case 5: CalcUnmei = "健弱" & IIf(ReigoFlg = True, "/陰影", "")
        Case 6: CalcUnmei = "達成" & IIf(ReigoFlg = True, "/停止", "")
        Case 7: CalcUnmei = "乱気" & IIf(ReigoFlg = True, "/減退", "")
        Case 8: CalcUnmei = "再会" & IIf(ReigoFlg = True, "/種子", "")
        Case 9: CalcUnmei = "財政" & IIf(ReigoFlg = True, "/緑生", "")
        Case 10: CalcUnmei = "安定" & IIf(ReigoFlg = True, "/立花", "")
        Case 11: CalcUnmei = "陰影" & IIf(ReigoFlg = True, "/健弱", "")
        Case 12: CalcUnmei = "停止" & IIf(ReigoFlg = True, "/達成", "")
        Case 1: CalcUnmei = "減退" & IIf(ReigoFlg = True, "/乱気", "")
    End Select
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

'年月日が全て「亥」の日'

Private Const baseDate As Date = #11/22/2019#

'運命星の列挙体'

Private Enum Unmei

DoPlus

DoMinus

kinPlus

kinMinus

KaPlus

KaMinus

TenPlus

TenMinus

MokuPlus

MokuMinus

SuiPlus

SuiMinus

End Enum

'運命判定関数'

Public Function GetUnmeiSei(ByVal 生年月日 As Variant) As String

Dim DayDiff As Integer: DayDiff = DateDiff("d", baseDate, 生年月日) Mod 60 + 1

Dim YearDiff As Integer: YearDiff = DateDiff("yyyy", baseDate, 生年月日) Mod 12 + 1

Dim ReigoFlg As Boolean: ReigoFlg = False

Dim PlusKbn As Integer: PlusKbn = Abs(DateDiff("yyyy", birthDay, 生年月日) Mod 2)

Dim un As Unmei

If IsEmpty(生年月日) Then Exit Function

DayDiff = DayDiff - 1

If DayDiff <= 0 Then DayDiff = DayDiff + 60

If YearDiff <= 0 Then YearDiff = YearDiff + 12

If PlusKbn = 1 Then

Select Case DayDiff

Case 1 To 10: un = DoPlus

Case 11 To 20: un = kinPlus

Case 21 To 30: un = KaPlus

Case 31 To 40: un = TenPlus

Case 41 To 50: un = MokuPlus

Case 51 To 60: un = SuiPlus

End Select

Else

Select Case DayDiff

Case 1 To 10: un = DoMinus

Case 11 To 20: un = kinMinus

Case 21 To 30: un = KaMinus

Case 31 To 40: un = TenMinus

Case 41 To 50: un = MokuMinus

Case 51 To 60: un = SuiMinus

End Select

End If

Select Case un

Case DoPlus: GetUnmeiSei = "土星人＋": If YearDiff = 12 Then ReigoFlg = True

Case DoMinus: GetUnmeiSei = "土星人‐": If YearDiff = 1 Then ReigoFlg = True

Case SuiPlus: GetUnmeiSei = "水星人＋": If YearDiff = 2 Then ReigoFlg = True

Case SuiMinus: GetUnmeiSei = "水星人‐": If YearDiff = 3 Then ReigoFlg = True

Case MokuPlus: GetUnmeiSei = "木星人＋": If YearDiff = 4 Then ReigoFlg = True

Case MokuMinus: GetUnmeiSei = "木星人‐": If YearDiff = 5 Then ReigoFlg = True

Case TenPlus: GetUnmeiSei = "天王星人＋": If YearDiff = 6 Then ReigoFlg = True

Case TenMinus: GetUnmeiSei = "天王星人‐": If YearDiff = 7 Then ReigoFlg = True

Case KaPlus: GetUnmeiSei = "火星人＋": If YearDiff = 8 Then ReigoFlg = True

Case KaMinus: GetUnmeiSei = "火星人‐": If YearDiff = 9 Then ReigoFlg = True

Case kinPlus: GetUnmeiSei = "金星人＋": If YearDiff = 10 Then ReigoFlg = True

Case kinMinus: GetUnmeiSei = "金星人‐": If YearDiff = 11 Then ReigoFlg = True

End Select

If ReigoFlg = True Then GetUnmeiSei = GetUnmeiSei & "（霊合）"

End Function

'年運算出関数'

Public Function GetYearUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String

Dim dDiff As Integer

dDiff = DateDiff("yyyy", baseDate, 占い対象日) Mod 12 + 1

GetYearUnmei = CalcUnmei(運命星, 占い対象日, dDiff)

End Function

'月運算出関数'

Public Function GetMonthUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String

Dim dDiff As Integer

dDiff = DateDiff("m", baseDate, 占い対象日) Mod 12 + 1

GetMonthUnmei = CalcUnmei(運命星, 占い対象日, dDiff)

End Function

'日運算出関数'

Public Function GetDayUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant) As String

Dim dDiff As Integer

dDiff = DateDiff("d", baseDate, 占い対象日) Mod 12 + 1

GetDayUnmei = CalcUnmei(運命星, 占い対象日, dDiff)

End Function

'運気計算'

Private Function CalcUnmei(ByVal 運命星 As Variant, ByVal 占い対象日 As Variant, ByVal dDiff As Variant) As String

'霊合判定'

Dim ReigoFlg As Boolean: ReigoFlg = False

If InStr(運命星, "霊合") > 0 Then ReigoFlg = True

'運気判定'

If dDiff <= 0 Then dDiff = dDiff + 12

Select Case dDiff

Case 1: 規定数 = 12

Case 2: 規定数 = 1

Case 3: 規定数 = 2

Case 4: 規定数 = 3

Case 5: 規定数 = 4

Case 6: 規定数 = 5

Case 7: 規定数 = 6

Case 8: 規定数 = 7

Case 9: 規定数 = 8

Case 10: 規定数 = 9

Case 11: 規定数 = 10

Case 12: 規定数 = 11

End Select

Select Case Replace(運命星, "（霊合）", "")

Case "土星人＋": 規定数 = 規定数 + 1

Case "土星人‐": 規定数 = 規定数

Case "水星人＋": 規定数 = 規定数 + 11

Case "水星人‐": 規定数 = 規定数 + 10

Case "木星人＋": 規定数 = 規定数 + 9

Case "木星人‐": 規定数 = 規定数 + 8

Case "天王星人＋": 規定数 = 規定数 + 7

Case "天王星人‐": 規定数 = 規定数 + 6

Case "火星人＋": 規定数 = 規定数 + 5

Case "火星人‐": 規定数 = 規定数 + 4

Case "金星人＋": 規定数 = 規定数 + 3

Case "金星人‐": 規定数 = 規定数 + 2

End Select

規定数 = 規定数 Mod 12

If 規定数 <= 0 Then 規定数 = 規定数 + 12

Select Case 規定数

Case 2: CalcUnmei = "種子" & IIf(ReigoFlg = True, "/再会", "")

Case 3: CalcUnmei = "緑生" & IIf(ReigoFlg = True, "/財政", "")

Case 4: CalcUnmei = "立花" & IIf(ReigoFlg = True, "/安定", "")

Case 5: CalcUnmei = "健弱" & IIf(ReigoFlg = True, "/陰影", "")

Case 6: CalcUnmei = "達成" & IIf(ReigoFlg = True, "/停止", "")

Case 7: CalcUnmei = "乱気" & IIf(ReigoFlg = True, "/減退", "")

Case 8: CalcUnmei = "再会" & IIf(ReigoFlg = True, "/種子", "")

Case 9: CalcUnmei = "財政" & IIf(ReigoFlg = True, "/緑生", "")

Case 10: CalcUnmei = "安定" & IIf(ReigoFlg = True, "/立花", "")

Case 11: CalcUnmei = "陰影" & IIf(ReigoFlg = True, "/健弱", "")

Case 12: CalcUnmei = "停止" & IIf(ReigoFlg = True, "/達成", "")

Case 1: CalcUnmei = "減退" & IIf(ReigoFlg = True, "/乱気", "")

End Select

End Function

運命星を算出する：GetUnmeiSei（生年月日）

上記のマクロを埋め込んでいると、自作関数GetUnmeiSeiがセルから呼び出せるようになります。運命星を算出する為のパラメーターは生年月日なので、生年月日を()の中に指定します。うまくマクロが機能していれば、算出結果として〇星人＋みたいな結果ができると思います。

運気を算出する

運命星がわかったら、その人物の運気を占いたい日にちを指定することで、運気を占うことができます。

年運：GetYearUnmei（運命星、占い対象日）

運命星毎の運気を占う関数としてGetYearUnmeiがセルで呼び出し可能となっていると思います。この関数のパラメーターは上記で算出した運命星と、占い対象日になるので、パラメーターを設定します。上手く関数が機能すれば、年の運気として種子とか緑生・・・みたいな内容が表示されます。

月運：GetMonthUnmei（運命星、占い対象日）

GetMonthUnmeiの関数に上記と同様のパラメーター指定をします。結果には月の運気が表示されます。

日運：GetDayUnmei（運命星、占い対象日）

GetDayUnmeiの関数に上記と同様のパラメーター指定をします。結果には日の運気が表示されます。

応用：六星占術を他の統計・法則と重ね合せる

情報を重ね合わせてピンポイントの「点」を見つけ出す

私は、物事の予測的中確率を上げる為には、他の統計情報や法則情報を重ね合せると良いと考えております。

１つの統計情報から導き出せれる予測結果を「面」だとします。
ここに２つ目の統計情報を加えて予測結果同士を重ね合わせると「線」まで絞り込みが出来ます。
さらに３つ目の統計情報を加えて予測結果同士を重ね合わせると「点」まで絞り込みが出来ます。
この「点」を狙うと予想は当たりやすいです

重ね合せで穴馬券を狙った例

私はこの重ね合わせの考えを元に、競馬で8桁円までお金を膨らませたことがあります。競馬は当たった時の配当が低いとつまらないので、配当が高い穴馬馬券を見つけ出し、購入するという方法です。情報として使っていたのは、次のような３つの情報の重ね合わせです。

競馬で重ね合せた情報

情報１．ジョッキーの運勢と新聞の評判
情報２．バイオリズム
情報３．裏情報

情報１．六星占術を活用する

新聞の評価が悪い馬で、運勢の良いジョッキーが乗り、
新聞の評価が良い馬で、運勢の悪いジョッキーが乗るレースを導きだします。

情報２．バイオリズムを活用する

新聞の評価が悪い馬で、バイオリズムの良いジョッキーが乗り、
新聞の評価が良い馬で、バイオリズムの悪いジョッキーが乗るレースを導きだします。

バイオリズムとは？

バイオリズムに関しては、別の投稿でご紹介しています。

ゆーはち茶飯事

バイオリズム：自分の身体・知性・感情の周期性を知り、生活に活かそう

https://puusenkou.com/biorhythm

あなたには、体調の波や周期性がありますか？私はこれを実感することはあまりないですが、女性を見ていると排卵や月経があり、何がしかの周期性はあると考えております。今回紹介するバイオリズムは、知る人ぞ知る日本の発明王の政木和三博士が見つけた周期性で、身体に関する周期に加えて、知性と感情の周期を算出したものです。本稿では、自身のこのバイオリズムを知る方法や、バイオリズムを知ることで仕事や勉強、人と関わると良いタイミング、子供の産み分けをする為に最適なタイミングの指針を得る方法を解説します。・人生のタ...

情報３．裏情報を活用する

新聞の評価が悪く、裏情報が良い馬
新聞の評価が良く、裏情報が悪い馬

裏情報とは

今はどうか知りませんが、昔は北海道でレースが開催される８月には穴馬情報が出回っていました。理由としては、この期間は札幌、小倉、新潟と遠隔地３カ所でレースが開かれる為、トラックマン（記者）が３手に分散していて正確な情報があまり出回らなかった為です。取り分け、北海道が一番遠いということで、北海道の情報が手薄になっていました。裏付けというわけではないですが、北海道競馬の勝率は道民の勝率が高かったそうです。

おまけ：JRA史上最多落馬レースの占い結果

2010年1月11日の中山第4レースを見たとき、占いがあたるって思いました。
この日、1つのレースにおける落馬頭数としては中央競馬史上最多の9頭落馬という事故がありました。
このときのジョッキーの運命は下表の通り。

年・月・日の運気が全部良いジョッキーが不在
バイオリズムも身体と感情がマイナスに割り込んでいるジョッキーが多い

たまたまかもしれないけどね。このレースなかなかお目に掛かれない光景なので、一見の価値がありますw

まとめ

今回は、Excelマクロを使った六星占術の運用方法をご紹介しました。興味があれば、身の回りの方々の運気を占ってみてあげてはどうかと思います。

ココに注意

Excelマクロのほう、色々と試して頂いてもよいですが、自己責任でお願いいたします。

ご閲覧ありがとうございます。
ではでは(^^)/