- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 44
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-2-20
               
|
6#
發表於 2013-1-8 00:08
| 只看該作者
本帖最後由 Hsieh 於 2013-1-8 00:09 編輯
回復 5# tmde987 - Sub 按鈕_1()
- Dim Ar()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each a In .Range(.[A2], .[A2].End(xlDown))
- d(a.Value) = a.Offset(, 4).Value
- Next
- For Each a In .Range(.[J2], .[J2].End(xlDown))
- i = a.Offset(, 4).Value - d(a.Value)
- If i <> 0 Then
- ReDim Preserve Ar(s)
- Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i, a.Offset(, 5).Value)
- s = s + 1
- End If
- Next
- End With
- Sheet2.UsedRange.Offset(1) = "" '第2列以下刪除
- Sheet2.[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) 'A2以下填入
- End Sub
- Sub 按鈕_2()
- Dim Ar()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each a In .Range(.[A2], .[A2].End(xlDown))
- d(a.Value) = a.Offset(, 4).Value
- Next
- For Each a In .Range(.[J2], .[J2].End(xlDown))
- i = a.Offset(, 4).Value - d(a.Value)
- If i <> 0 Then
- ReDim Preserve Ar(s)
- Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 3).Value, i)
- s = s + 1
- End If
- Next
- End With
- Sheet3.UsedRange.Offset(1) = "" '第2列以下刪除
- Sheet3.[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar)) 'A2以下填入
- End Sub
- Sub 按鈕_3()
- Dim Ar()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each a In .Range(.[A2], .[A2].End(xlDown))
- d(a.Value) = a.Offset(, 4).Value
- Next
- For Each a In .Range(.[J2], .[J2].End(xlDown))
- i = a.Offset(, 4).Value - d(a.Value)
- If i <> 0 Then
- ReDim Preserve Ar(s)
- Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 3).Value, i)
- s = s + 1
- End If
- Next
- End With
- Sheet4.UsedRange.Offset(2) = "" '第3列以下刪除
- Sheet4.[A3].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar)) 'A3以下填入
- End Sub
- Sub 按鈕_4()
- Dim Ar()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each a In .Range(.[A2], .[A2].End(xlDown))
- d(a.Value) = a.Offset(, 4).Value
- Next
- For Each a In .Range(.[J2], .[J2].End(xlDown))
- i = a.Offset(, 4).Value - d(a.Value)
- If i <> 0 Then
- ReDim Preserve Ar(s)
- Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i, "=RC[-2]*RC[-1]")
- s = s + 1
- End If
- Next
- End With
- Sheet5.UsedRange.Offset(2) = "" '第3列以下刪除
- Sheet5.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) 'A3以下填入
- End Sub
- Sub 按鈕_5()
- Dim Ar()
- With Sheet6
- For Each a In .Range(.[A2], .[A2].End(xlDown))
- i = Application.Max(0, a.Offset(, 5).Value - a.Offset(, 4).Value) '計算購買數量
- ReDim Preserve Ar(s)
- Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, i)
- s = s + 1
- Next
- End With
- Sheet6.UsedRange.Offset(2, 8) = "" 'I3以下刪除
- Sheet6.[I3].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar)) 'I3以下填入
- End Sub
|
|
發表於 2013-1-6 21:08
| 
