0

如果满足 Col 和 row 参数,我正在尝试复制和粘贴我的某些值

但似乎代码正在运行,但输出中没有显示数据

我尝试了不同的方法,但都没有成功

Sub SalesDownload()

Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim vFile As Variant
Dim Channel As String
Dim Month As String
Dim i As Integer, j As Integer
Dim k As Integer, l As Integer



Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = Worksheets("Sales")
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile, ReadOnly:=True)
Set wsCopyFrom = wbCopyFrom.Worksheets("FMS1")
End If

'--------------------------------------------------------------
'Copy Range
'wsCopyFrom.Range("C5:O16").Copy
'wsCopyTo.Range("a1").PasteSpecial Paste:=xlPasteValues, _
'Operation:=xlNone, SkipBlanks:=False, Transpose:=False



For i = 6 To 18



Channel = wsCopyFrom.Cells(i, 3).Value
For j = 4 To 39
Month = wsCopyFrom.Cells(5, j).Value

For k = 2 To 14
For l = 2 To 18
If wsCopyTo.Cells(k, 1).Value = Channel Then
If wsCopyTo.Cells(2, l).Value = Month Then
wsCopyFrom.Activate
wsCopyFrom.Cells(i, j).Value.Copy
wsCopyTo.Activate
wsCopyTo.Cells(k, l).Select.PasteSpecial Paste:=xlPasteValues
End If
End If

Next l
Next k
Next j
Next i

'Close file that was opened
Application.DisplayAlerts = False
wbCopyFrom.Close

MsgBox "Done!!!"


'SaveChanges:=False

End Sub
4

1 回答 1

0

您是否应该考虑在不使用 excel api 的情况下复制数据?代替

wsCopyFrom.Activate
wsCopyFrom.Cells(i, j).Value.Copy
wsCopyTo.Activate
wsCopyTo.Cells(k, l).Select.PasteSpecial Paste:=xlPasteValues

使用变量,例如:

set value = wsCopyFrom.Cells(i, j).Value
wsCopyTo.Cells(k, l).Value = value;

它会更快,并且不依赖于 excel UI。

于 2019-08-22T03:07:19.347 回答