Question

我有两个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

Answer 1

我加入@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

BTW：你应该在循环之外Application.DisplayAlerts = True。

Answer 2

试试这个

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

仅在VBA中从彩色单元格复制数据

2 个答案: