返回列表 上一主題 發帖

想問我的EXCEL比對資料要怎麼寫

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
244  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-6 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2013-1-8 00:08 | 顯示全部帖子
本帖最後由 Hsieh 於 2013-1-8 00:09 編輯

回復 5# tmde987
  1. Sub 按鈕_1()
  2. Dim Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5.   For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.      d(a.Value) = a.Offset(, 4).Value
  7.   Next
  8.   For Each a In .Range(.[J2], .[J2].End(xlDown))
  9.      i = a.Offset(, 4).Value - d(a.Value)
  10.      If i <> 0 Then
  11.      ReDim Preserve Ar(s)
  12.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i, a.Offset(, 5).Value)
  13.      s = s + 1
  14.      End If
  15.   Next
  16. End With
  17. Sheet2.UsedRange.Offset(1) = "" '第2列以下刪除
  18. Sheet2.[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) 'A2以下填入
  19. End Sub
複製代碼
  1. Sub 按鈕_2()
  2. Dim Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5.   For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.      d(a.Value) = a.Offset(, 4).Value
  7.   Next
  8.   For Each a In .Range(.[J2], .[J2].End(xlDown))
  9.      i = a.Offset(, 4).Value - d(a.Value)
  10.      If i <> 0 Then
  11.      ReDim Preserve Ar(s)
  12.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 3).Value, i)
  13.      s = s + 1
  14.      End If
  15.   Next
  16. End With
  17. Sheet3.UsedRange.Offset(1) = "" '第2列以下刪除
  18. Sheet3.[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar)) 'A2以下填入
  19. End Sub
複製代碼
  1. Sub 按鈕_3()
  2. Dim Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5.   For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.      d(a.Value) = a.Offset(, 4).Value
  7.   Next
  8.   For Each a In .Range(.[J2], .[J2].End(xlDown))
  9.      i = a.Offset(, 4).Value - d(a.Value)
  10.      If i <> 0 Then
  11.      ReDim Preserve Ar(s)
  12.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 3).Value, i)
  13.      s = s + 1
  14.      End If
  15.   Next
  16. End With
  17. Sheet4.UsedRange.Offset(2) = "" '第3列以下刪除
  18. Sheet4.[A3].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar)) 'A3以下填入
  19. End Sub
複製代碼
  1. Sub 按鈕_4()
  2. Dim Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5.   For Each a In .Range(.[A2], .[A2].End(xlDown))
  6.      d(a.Value) = a.Offset(, 4).Value
  7.   Next
  8.   For Each a In .Range(.[J2], .[J2].End(xlDown))
  9.      i = a.Offset(, 4).Value - d(a.Value)
  10.      If i <> 0 Then
  11.      ReDim Preserve Ar(s)
  12.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i, "=RC[-2]*RC[-1]")
  13.      s = s + 1
  14.      End If
  15.   Next
  16. End With
  17. Sheet5.UsedRange.Offset(2) = "" '第3列以下刪除
  18. Sheet5.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) 'A3以下填入
  19. End Sub
複製代碼
  1. Sub 按鈕_5()
  2. Dim Ar()
  3. With Sheet6
  4.   For Each a In .Range(.[A2], .[A2].End(xlDown))
  5.      i = Application.Max(0, a.Offset(, 5).Value - a.Offset(, 4).Value) '計算購買數量
  6.      ReDim Preserve Ar(s)
  7.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i)
  8.      s = s + 1
  9.   Next
  10. End With
  11. Sheet6.UsedRange.Offset(2, 8) = "" 'I3以下刪除
  12. Sheet6.[I3].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar)) 'I3以下填入
  13. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題