Question

我得到＆＃34; error13类型不匹配＆＃34;在代码的第7行（If ActiveSheet.Cells(1, 47) = 1 Then）中迭代工作簿中的所有工作表时。有谁知道如何解决这个问题？

Dim y As Integer
Dim c As Integer
Dim ws_num As Integer

Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ThisWorkbook.Worksheets.Count
For y = 1 To ws_num
    ThisWorkbook.Worksheets(y).Activate
    If ActiveSheet.Cells(1, 47) = 1 Then
        Worksheets("Podsumowanie").Cells(2, y + 1) = ThisWorkbook.Worksheets(y).Range("U2")
        Worksheets("Podsumowanie").Cells(3, y + 1) = ThisWorkbook.Worksheets(y).Range("V2")
        Worksheets("Podsumowanie").Cells(4, y + 1) = ThisWorkbook.Worksheets(y).Range("W2")

        Worksheets("Podsumowanie").Cells(5, y + 1) = ThisWorkbook.Worksheets(y).Range("P3")
        Worksheets("Podsumowanie").Cells(6, y + 1) = ThisWorkbook.Worksheets(y).Range("Q3")
        Worksheets("Podsumowanie").Cells(7, y + 1) = ThisWorkbook.Worksheets(y).Range("R3")
        Worksheets("Podsumowanie").Cells(8, y + 1) = ThisWorkbook.Worksheets(y).Range("S3")
    Else
        Worksheets("Podsumowanie").Cells(2, y + 1) = ThisWorkbook.Worksheets(y).Range("U2")
        Worksheets("Podsumowanie").Cells(3, y + 1) = ThisWorkbook.Worksheets(y).Range("V2")
        Worksheets("Podsumowanie").Cells(4, y + 1) = ThisWorkbook.Worksheets(y).Range("W2")

        Worksheets("Podsumowanie").Cells(5, y + 1) = ThisWorkbook.Worksheets(y).Range("P8")
        Worksheets("Podsumowanie").Cells(6, y + 1) = ThisWorkbook.Worksheets(y).Range("Q8")
        Worksheets("Podsumowanie").Cells(7, y + 1) = ThisWorkbook.Worksheets(y).Range("R8")
        Worksheets("Podsumowanie").Cells(8, y + 1) = ThisWorkbook.Worksheets(y).Range("S8")
    End If
Next

Answer 1

尝试使用此代替

Dim y As Long
Dim PodSheet As Worksheet

Set PodSheet = ThisWorkbook.Sheets("Podsumowanie")

For y = 1 To ThisWorkbook.Worksheets.Count
    With ThisWorkbook.Sheets(y)
        If .Cells(1, 47).Value2 = 1 Then
            PodSheet.Cells(2, y + 1) = .Range("U2")
            PodSheet.Cells(3, y + 1) = .Range("V2")
            PodSheet.Cells(4, y + 1) = .Range("W2")
            PodSheet.Cells(5, y + 1) = .Range("P3")
            PodSheet.Cells(6, y + 1) = .Range("Q3")
            PodSheet.Cells(7, y + 1) = .Range("R3")
            PodSheet.Cells(8, y + 1) = .Range("S3")
        Else
            PodSheet.Cells(2, y + 1) = .Range("U2")
            PodSheet.Cells(3, y + 1) = .Range("V2")
            PodSheet.Cells(4, y + 1) = .Range("W2")
            PodSheet.Cells(5, y + 1) = .Range("P8")
            PodSheet.Cells(6, y + 1) = .Range("Q8")
            PodSheet.Cells(7, y + 1) = .Range("R8")
            PodSheet.Cells(8, y + 1) = .Range("S8")
        End If
    End With
Next y

Answer 2

当Cells(1, 47)包含错误时，会导致

类型不匹配错误 - 以避免使用 IsError() 当单元格为空或不包含数字

时，将导致另一个问题

你也可以尽量减少汤姆答案中的重复，而不是。激活每张纸这包含所有建议，但未经过测试（您未包括完整程序）

Dim y As Long, c As Long, thisCol As Long, pCol As Long
Dim ws As Worksheet, podWs As Worksheet, cel As Range

Set podWs = ThisWorkbook.Worksheets("Podsumowanie")

For Each ws In ThisWorkbook.Worksheets
    With ws
        pCol = .Index + 1
        podWs.Cells(2, pCol) = .Range("U2")
        podWs.Cells(3, pCol) = .Range("V2")
        podWs.Cells(4, pCol) = .Range("W2")
        Set cel = .Cells(1, 47)
        If Not IsError(cel) Then
            If IsNumeric(cel.Value2) Then
                thisCol = IIf(cel = 1, 3, 8)
                podWs.Cells(5, pCol) = .Range("P" & thisCol)
                podWs.Cells(6, pCol) = .Range("Q" & thisCol)
                podWs.Cells(7, pCol) = .Range("R" & thisCol)
                podWs.Cells(8, pCol) = .Range("S" & thisCol)
            End If
        End If
    End With
Next

工作表循环类型不匹配错误

2 个答案: