仅在VBA中从彩色单元格复制数据
仅在VBA中从彩色单元格复制数据
提问于 2018-04-19 17:35:25
我有两个excel工作表和一个宏，它只复制具有特定背景颜色的单元格。其余的不应该被复制，因为我想保留原始excel中的公式。我的代码如下，它给出了错误。错误是类型不匹配，它对应于循环中的if语句。
Sub Take_Worksheet()
Dim strPath As String
Dim intChoice As Integer
Dim i As Integer, j As Integer
MsgBox "Select the Comments sheet"
Dim wb As Workbook
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Set wb = Workbooks.Open(strPath)
End If
For i = 1 To 100
For j = 1 To 20
If ThisWorkbook.Sheets("Comments").Cells(i, j) <> wb.Sheets("Comments").Cells(i, j) And wb.Sheets("Comments").Cells(i, j).Interior.Color = RGB(218, 238, 243) Then
ThisWorkbook.Sheets("Comments").Cells(i, j) = wb.Sheets("Comments").Cells(i, j)
End If
Application.DisplayAlerts = True
Next j
Next i
End Sub回答 2
Stack Overflow用户
发布于 2018-04-19 21:21:15
我加入了@SJR:类型不匹配通常发生在某些单元格出错的情况下。你可以这样处理：
If Not IsError(wb.Sheets("Comments").Cells(i, j)) Then
If ThisWorkbook.Sheets("Comments").Cells(i, j) <> wb.Sheets("Comments").Cells(i, j) And _
wb.Sheets("Comments").Cells(i, j).Interior.Color = RGB(218, 238, 243) Then
ThisWorkbook.Sheets("Comments").Cells(i, j) = wb.Sheets("Comments").Cells(i, j)
End If
End If顺便说一句:你应该在循环之外使用Application.DisplayAlerts = True。
Stack Overflow用户
发布于 2018-04-19 22:09:39
尝尝这个
Option Explicit
Public Sub Take_Worksheet()
Dim wsSel As Worksheet, wbPath As String, wsCom As Worksheet
Dim i As Long, j As Long, usrSelection As Long
'MsgBox "Select the Comments sheet"
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Select the Comments sheet"
usrSelection = .Show
End With
If usrSelection <> 0 Then 'continue only if user didn't cancel
Set wsCom = ThisWorkbook.Worksheets("Comments")
Set wsSel = Workbooks.Open(wbPath).Worksheets("Comments")
wbPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Application.DisplayAlerts = False
For i = 1 To 100 'or wsCom.UsedRange.Rows.Count
For j = 1 To 20 'or wsCom.UsedRange.Columns.Count
If wsCom.Cells(i, j) <> wsSel.Cells(i, j) And _
wsSel.Cells(i, j).Interior.Color = RGB(218, 238, 243) Then
wsCom.Cells(i, j) = wsSel.Cells(i, j)
End If
Next j
Next i
Application.DisplayAlerts = True
End If
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/49917640
复制相关文章
相似问题
腾讯云开发者
