工作表循环types不匹配错误

在代码的第7行（ If ActiveSheet.Cells(1, 47) = 1 Then 1,47 If ActiveSheet.Cells(1, 47) = 1 Then ）迭代工作簿中的所有工作表时，出现“error13types不匹配”。 有谁知道如何解决这一问题？

 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() Cells(1, 47)包含错误时会导致types不匹配错误 – 以避免使用IsError()单元格为空或不包含数字时会导致另一个问题

你也可以像汤姆的回答那样减less重复，而不是。激活每张纸
这包含所有的build议，但没有testing（你没有包括完整的程序）

---

 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