- 帖子
- 36
- 主題
- 8
- 精華
- 0
- 積分
- 44
- 點名
- 0
- 作業系統
- win 7
- 軟體版本
- office 2007
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2013-1-8
- 最後登錄
- 2020-10-29
|
4#
發表於 2019-10-18 19:07
| 只看該作者
回復 3# 小華
紅色這段一直跑迴圈 跳不出來 資料量有上千筆
Set x = Workbooks("CL Diff.xlsm").Sheets("Upload-1")
Set y = Workbooks("CL Diff.xlsm").Sheets("MB58")
Set Z = Workbooks("CL Diff.xlsm").Sheets("Diff")
i = Z.Cells(1, 1).End(xlDown).Row
b = y.Cells(1, 1).End(xlDown).Row
c = x.Range("L1")
For k = 2 To i
f = Z.Cells(k, 8)
If Z.Cells(k, 18) <> 0 Then
If Z.Cells(k, 26) = "" Then
For j = 2 To b
q = y.Cells(j, 7) - Z.Cells(k, 18)
If y.Cells(j, 8) = f And y.Cells(j, 2) = Z.Cells(k, 2) And q > 0 Then
x.Cells(c + 2, 1) = Z.Cells(k, 2)
x.Cells(c + 2, 2) = Z.Cells(k, 3)
x.Cells(c + 2, 3) = Z.Cells(k, 4)
x.Cells(c + 2, 4) = Z.Cells(k, 5)
x.Cells(c + 2, 5) = Z.Cells(k, 6)
x.Cells(c + 2, 6) = Z.Cells(k, 7)
x.Cells(c + 2, 7) = Z.Cells(k, 8)
x.Cells(c + 2, 8) = Z.Cells(k, 9)
x.Cells(c + 2, 9) = Z.Cells(k, 18)
Z.Cells(k, 26) = "OK"
ElseIf q < 0 Then
x.Cells(c + 2, 1) = Z.Cells(k, 2)
x.Cells(c + 2, 2) = Z.Cells(k, 3)
x.Cells(c + 2, 3) = Z.Cells(k, 4)
x.Cells(c + 2, 4) = Z.Cells(k, 5)
x.Cells(c + 2, 5) = Z.Cells(k, 6)
x.Cells(c + 2, 6) = Z.Cells(k, 7)
x.Cells(c + 2, 7) = Z.Cells(k, 8)
x.Cells(c + 2, 8) = Z.Cells(k, 9)
x.Cells(c + 2, 9) = y.Cells(j, 7)
Z.Cells(k, 26) = "數量差" & q
End If
Next j
End If
End If
Z.Cells(k, 26) = "無量差"
Next k
MsgBox ("資料已整理完畢")
End Sub |
|
