EXCEL-VBA函數：農曆轉公曆，格式YYYY-MM-DD

VBA調用：MsgBox Lunar2Gong("1981-07-27")

公式調用：Lunar2Gong("1981-07-27")

Public Function Lunar2Gong(Optional Lunar As Date)
    Dim LunarYear, LunarMonth, LunarDay
    Dim NongliData(100)
      '農曆數據
  NongliData(0) = 2635
  NongliData(1) = 333387
  NongliData(2) = 1701
  NongliData(3) = 1748
  NongliData(4) = 267701
  NongliData(5) = 694
  NongliData(6) = 2391
  NongliData(7) = 133423
  NongliData(8) = 1175
  NongliData(9) = 396438
  NongliData(10) = 3402
  NongliData(11) = 3749
  NongliData(12) = 331177
  NongliData(13) = 1453
  NongliData(14) = 694
  NongliData(15) = 201326
  NongliData(16) = 2350
  NongliData(17) = 465197
  NongliData(18) = 3221
  NongliData(19) = 3402
  NongliData(20) = 400202
  NongliData(21) = 2901
  NongliData(22) = 1386
  NongliData(23) = 267611
  NongliData(24) = 605
  NongliData(25) = 2349
  NongliData(26) = 137515
  NongliData(27) = 2709
  NongliData(28) = 464533
  NongliData(29) = 1738
  NongliData(30) = 2901
  NongliData(31) = 330421
  NongliData(32) = 1242
  NongliData(33) = 2651
  NongliData(34) = 199255
  NongliData(35) = 1323
  NongliData(36) = 529706
  NongliData(37) = 3733
  NongliData(38) = 1706
  NongliData(39) = 398762
  NongliData(40) = 2741
  NongliData(41) = 1206
  NongliData(42) = 267438
  NongliData(43) = 2647
  NongliData(44) = 1318
  NongliData(45) = 204070
  NongliData(46) = 3477
  NongliData(47) = 461653
  NongliData(48) = 1386
  NongliData(49) = 2413
  NongliData(50) = 330077
  NongliData(51) = 1197
  NongliData(52) = 2637
  NongliData(53) = 268877
  NongliData(54) = 3365
  NongliData(55) = 531109
  NongliData(56) = 2900
  NongliData(57) = 2922
  NongliData(58) = 398042
  NongliData(59) = 2395
  NongliData(60) = 1179
  NongliData(61) = 267415
  NongliData(62) = 2635
  NongliData(63) = 661067
  NongliData(64) = 1701
  NongliData(65) = 1748
  NongliData(66) = 398772
  NongliData(67) = 2742
  NongliData(68) = 2391
  NongliData(69) = 330031
  NongliData(70) = 1175
  NongliData(71) = 1611
  NongliData(72) = 200010
  NongliData(73) = 3749
  NongliData(74) = 527717
  NongliData(75) = 1452
  NongliData(76) = 2742
  NongliData(77) = 332397
  NongliData(78) = 2350
  NongliData(79) = 3222
  NongliData(80) = 268949
  NongliData(81) = 3402
  NongliData(82) = 3493
  NongliData(83) = 133973
  NongliData(84) = 1386
  NongliData(85) = 464219
  NongliData(86) = 605
  NongliData(87) = 2349
  NongliData(88) = 334123
  NongliData(89) = 2709
  NongliData(90) = 2890
  NongliData(91) = 267946
  NongliData(92) = 2773
  NongliData(93) = 592565
  NongliData(94) = 1210
  NongliData(95) = 2651
  NongliData(96) = 395863
  NongliData(97) = 1323
  NongliData(98) = 2707
  NongliData(99) = 265877
  NongliData(100) = 1706
 
  Dim m, monthCount, toCurMonthCnt, LeapMonth, TheDate, curTime
  Dim i1, i2, i3, bit
  
  '獲取當前變量日期
  curTime = Lunar
  LunarYear = Year(curTime)
  LunarMonth = Month(curTime)
  LunarDay = Day(curTime)

  m = LunarYear - 1921
  monthCount = 0
  toCurMonthCnt = 0
  LeapMonth = -1
  TheDate = LunarDay - 1
 
    For i1 = 0 To m - 1 Step 1
        If (NongliData(i1) < 4095) Then
            monthCount = 11
        Else
            monthCount = 12
        End If
        For i2 = 0 To monthCount Step 1
            bit = NongliData(i1)
            For i3 = 1 To i2 Step 1
                    bit = Int(bit / 2)
            Next
            bit = bit Mod 2
            TheDate = TheDate + 29 + bit
        Next
    Next
   
    If (NongliData(m) < 4095) Then
        monthCount = 11
        toCurMonthCnt = monthCount - LunarMonth + 2
    Else
        monthCount = 12
        toCurMonthCnt = monthCount - LunarMonth + 1
        LeapMonth = Int(NongliData(m) / 65536)
        If LunarMonth <= LeapMonth Then toCurMonthCnt = toCurMonthCnt + 1
    End If
   
    For i2 = monthCount To toCurMonthCnt Step -1
        bit = NongliData(m)
        For i3 = 1 To i2 Step 1
                bit = Int(bit / 2)
        Next
        bit = bit Mod 2
        TheDate = TheDate + 29 + bit
    Next
   
    Lunar2Gong = DateAdd("d", TheDate, "1921/2/8")
End Function