又来请教大大,
要将list档案(53笔data)
汇整至两个不同档案(超过1300笔data,其他字段有填满和公式格式设定)
但一个档案就要跑5分钟@@,
有办法修改让他跑快一点吗?
程式码如下,附上VBA档案&File连结,会比较清楚&可编辑
https://reurl.cc/D1j3GN
再麻烦解惑,感谢喔~
Sub MFile()
Dim X As Long
Dim i As Integer
M = "MFile"
OnLineList = "list"
'如果I栏(上线清单)=1,
Windows(OnLineList).Activate
Sheets("资料合并整理for单列").Range("A2").Select
For i = 2 To ActiveCell.SpecialCells(xlLastCell).Row
If Windows(OnLineList).ActiveSheet.Range("I" & i) = 1 Then
Windows(M).Activate
Sheets("2019").Range("I5").Select
For k = 5 To ActiveCell.SpecialCells(xlLastCell).Row
If Windows(M).ActiveSheet.Range("I" & k) = Windows(OnLineList).ActiveSheet.Range("A" & i) And _
Windows(M).ActiveSheet.Range("AJ" & k) = "" Then
Windows(M).ActiveSheet.Range("AJ" & k) = Windows(OnLineList).ActiveSheet.Range("B" & i)
Windows(M).ActiveSheet.Range("AQ" & k) = Windows(OnLineList).ActiveSheet.Range("C" & i)
Windows(M).ActiveSheet.Range("AH" & k) = Windows(OnLineList).ActiveSheet.Range("F" & i)
Windows(M).ActiveSheet.Range("AJ" & k).Interior.Color = 15773696
Windows(M).ActiveSheet.Range("AQ" & k).Interior.Color = 15773696
Windows(M).ActiveSheet.Range("AH" & k).Interior.Color = 15773696
Windows(OnLineList).ActiveSheet.Range("B" & i).Interior.Color = 15773696
Windows(OnLineList).ActiveSheet.Range("C" & i).Interior.Color = 15773696
Windows(OnLineList).ActiveSheet.Range("F" & i).Interior.Color = 15773696
Else
If Windows(M).ActiveSheet.Range("I" & k) = Windows(OnLineList).ActiveSheet.Range("A" & i) And _
Windows(M).ActiveSheet.Range("AJ" & k) <> "" Then
Windows(M).ActiveSheet.Range("AJ" & k).Interior.Color = 1111111
Windows(M).ActiveSheet.Range("AQ" & k).Interior.Color = 1111111
Windows(M).ActiveSheet.Range("AH" & k).Interior.Color = 1111111
Windows(OnLineList).ActiveSheet.Range("B" & i).Interior.Color = 1111111
Windows(OnLineList).ActiveSheet.Range("C" & i).Interior.Color = 1111111
Windows(OnLineList).ActiveSheet.Range("F" & i).Interior.Color = 1111111
End If
End If
Next
End If
Next
End Sub