返回列表 上一主題 發帖

複製公式

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
1# 跳轉到 »
發表於 2014-3-22 15:09 | 顯示全部帖子
本帖最後由 yen956 於 2014-3-22 15:15 編輯

回復 19# myleoyes
試試看:
  1. Sub 建立日期比對表()
  2.     Dim i As Integer
  3.     Sheets("Sheet1").Activate
  4.    
  5.     '根據 [B3], 填入連續9個月的 結算日期 到 欄Z
  6.     '並填入連續9個月的 年月 到 欄Y, 供 [Y2] Match 年月 用
  7.     '因為某些月份超過1筆, 且同月份須寫在同一列, 故用 MATCH 比對是否同一月份的資料
  8.     '請修改 For i = 1 To 9 之 9, 如果預計要要建立連續 12個月的資料, 則改為 12
  9.     For i = 1 To 9
  10.         Cells(i + 2, 26) = DateSerial(Year([B3]), Month([B3]) + i, 1) - 1
  11.         Cells(i + 2, 25) = Year(Cells(i + 2, 26)) - 1911 & Month(Cells(i + 2, 26))
  12.     Next i
  13. End Sub

  15. Sub Exyen()
  16.     Dim Rng, chkRng As Range
  17.     Dim i, endRow, endRow2, blankRow As Integer
  18.     endRow = [A2000].End(xlUp).Row
  19.     [AH1].Resize(200, 40) = ""
  20.     [Y3].Resize(200, 2) = ""
  21.     建立日期比對表
  22.     endRow2 = [Y200].End(xlUp).Row
  23.    
  24.     Sheets("Sheet1").Activate
  25.     [M3] = 0.0254                 '此列 "借用" M$3是個變數並非固定值
  26.     blankRow = 3
  27.     oldRow = 3
  28.     Application.Calculation = xlManual
  29.    
  30.     For i = 3 To endRow
  31.    
  32.         '若 Cells(2, i + 31)<>"", 則這筆資料己結算過, 換下一筆
  33.         If Cells(2, i + 31) <> "" Then GoTo next1:
  34.         
  35.         '否則將 編號 寫入 Cells(2, i + 31)
  36.         Cells(2, i + 31) = Cells(i, 1)
  37.         
  38.         '將 目前這一筆 欄B 之 年月放入 [Y1], 供 [Y2] Match 比對年月 用
  39.         [Y1] = Year(Cells(i, 2)) - 1911 & Month(Cells(i, 2))
  40.         
  41.         '因為某些月份超過1筆, 且同月份須寫在同一列, 故用 MATCH 比對是否同一月份的資料
  42.         [Y2] = "=MATCH(Y1,Y3:Y200,0)"
  43.         
  44.         blankRow = [Y2] + 2
  45.         If Cells(i, 1) <> 0 Then
  46.             Range(Cells(blankRow, i + 31), Cells(endRow2, i + 31)) = "=ROUND($F$" & i & "*$M$3,2)"
  47.         Else
  48.             Range(Cells(blankRow, i + 31), Cells(i, i + 31)) = "=ROUND($F$" & i & "*$M$3,2)"
  49.         End If
  50.         Cells(1, i + 31) = "=SUM(R3C" & i + 31 & ":R200C" & i + 31 & ")"
  51. next1:
  52.      Next
  53.      Application.Calculation = xlAutomatic
  54. End Sub
複製代碼

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題