Riolan

Necessito pesquisar uma tabela de 30 colunas por +/- 2000 linhas, contendo codigos de tendimento em serviço de saude. As colunas são indicativas de diagnóstico e intercorrencias em um mesmo paciente. A pesquisa deve ser realizada nas combinações de 5 a 10 entre as 30 colunas. Porém ta dndo o erro "1004" após a realizaçõ do 1º laço do loop. O erro dá na linha da funçõ CountIfs. Abaixo o codigo: Sub Afinidade() ' ' Afinidade Macro ' ' Dim lin1 As Integer Dim lin2 As Integer Dim linE As Integer Dim lin5 As Integer Dim lin6 As Integer Dim lin7 As Integer Dim lin8 As Integer Dim lin9 As Integer Dim linR As Integer Dim colM1 As Integer Dim colM2 As Integer Dim colM3 As Integer Dim colM4 As Integer Dim colM5 As Integer Dim colM6 As Integer Dim colM7 As Integer Dim colM8 As Integer Dim colM9 As Integer Dim colM10 As Integer Dim colM11 As Integer Dim colP1 As Integer Dim colP2 As Integer Dim colP3 As Integer Dim colP4 As Integer Dim colP5 As Integer Dim colP6 As Integer Dim colP7 As Integer Dim colP8 As Integer Dim colP9 As Integer Dim colP10 As Integer Dim colR As Integer Dim num1 As Integer Dim num2 As Integer Dim num3 As Integer Dim num4 As Integer Dim num5 As Integer Dim num6 As Integer Dim num7 As Integer Dim num8 As Integer Dim num9 As Integer Dim num10 As Integer Dim rm(25) As Range Worksheets("Plan3").Activate Set rm(1) = Range("C2:C521") Set rm(2) = Range("D2:D521") Set rm(3) = Range("E2:E521") Set rm(4) = Range("F2:F521") Set rm(5) = Range("G2:G521") Set rm(6) = Range("H2:G521") Set rm(7) = Range("I2:I251") Set rm(8) = Range("J2:J251") Set rm(9) = Range("K2:K251") Set rm(10) = Range("L2:L251") Set rm(11) = Range("M2:M251") Set rm(12) = Range("N2:N251") Set rm(13) = Range("O2:O251") Set rm(14) = Range("P2:P251") Set rm(15) = Range("Q2:Q251") Set rm(16) = Range("R2:R251") Set rm(17) = Range("S2:S251") Set rm(18) = Range("T2:T251") Set rm(19) = Range("U2:U251") Set rm(20) = Range("V2:V251") Set rm(21) = Range("Y2:Y251") Set rm(22) = Range("X2:X251") Set rm(23) = Range("W2:W251") Set rm(24) = Range("Z2:Z251") Set rm(25) = Range("AA2:AA251") lin1 = 2 lin2 = 521 lin5 = 0 lin6 = 0 lin7 = 0 lin8 = 0 lin9 = 0 linR = 2 colR = 40 afim = 0 colP1 = 29 colP2 = 30 colP3 = 31 colP4 = 32 colP5 = 33 colP6 = 34 colP7 = 35 colP8 = 36 colP9 = 37 colP10 = 38 '-------Pesquisa de 5 For num1 = 1 To 21 colM1 = num1 + 2 For num2 = num1 + 1 To 22 colM2 = num2 + 2 For num3 = num2 + 1 To 23 colM3 = num3 + 2 For num4 = num3 + 1 To 24 colM4 = num4 + 2 For num5 = num4 + 1 To 25 colM5 = num5 + 2 ' Application. Worksheets("Plan2").Activate Range("A601:H608").Formula = "=Rand()" Worksheets("Plan3").Activate afim = WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num5 Next num4 Next num3 Next num2 Next num1 'Range("A1").Value = "" '---------Pesquisa de 6 lin5 = linR For linE = 1 To lin5 num1 = Cells(linE, colP1).Value num2 = Cells(linE, colP2).Value num3 = Cells(linE, colP3).Value num4 = Cells(linE, colP4).Value num5 = Cells(linE, colP5).Value For num6 = num5 + 1 To 25 colM6 = num6 + 2 afim = Application.WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5, rm(num6), num6) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Cells(linE, colP1).Value = 0 Cells(linE, colP2).Value = 0 Cells(linE, colP3).Value = 0 Cells(linE, colP4).Value = 0 Cells(linE, colP5).Value = 0 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num6 Next linE '---------Pesquisa de 7 lin6 = linR For linE = lin5 + 1 To lin6 num1 = Cells(linE, colP1).Value num2 = Cells(linE, colP2).Value num3 = Cells(linE, colP3).Value num4 = Cells(linE, colP4).Value num5 = Cells(linE, colP5).Value num6 = Cells(linE, colP6).Value For num7 = num6 + 1 To 25 colM7 = num7 + 2 afim = Application.WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5, rm(num6), num6, _ rm(num7), num7) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Cells(linE, colP1).Value = 0 Cells(linE, colP2).Value = 0 Cells(linE, colP3).Value = 0 Cells(linE, colP4).Value = 0 Cells(linE, colP5).Value = 0 Cells(linE, colP6).Value = 0 Cells(linE, colP7).Value = 0 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num7 Next linE '---------Pesquisa de 8 lin7 = linR For linE = lin6 + 1 To lin7 num1 = Cells(linE, colP1).Value num2 = Cells(linE, colP2).Value num3 = Cells(linE, colP3).Value num4 = Cells(linE, colP4).Value num5 = Cells(linE, colP5).Value num6 = Cells(linE, colP6).Value num7 = Cells(linE, colP7).Value For num8 = num7 + 1 To 25 colM8 = num8 + 2 afim = Application.WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5, rm(num6), num6, _ rm(num7), num7, rm(num8), num8) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Cells(linE, colP1).Value = 0 Cells(linE, colP2).Value = 0 Cells(linE, colP3).Value = 0 Cells(linE, colP4).Value = 0 Cells(linE, colP5).Value = 0 Cells(linE, colP6).Value = 0 Cells(linE, colP7).Value = 0 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num8 Next linE '---------Pesquisa de 9 lin8 = linR For linE = lin7 + 1 To lin8 num1 = Cells(linE, colP1).Value num2 = Cells(linE, colP2).Value num3 = Cells(linE, colP3).Value num4 = Cells(linE, colP4).Value num5 = Cells(linE, colP5).Value num6 = Cells(linE, colP6).Value num7 = Cells(linE, colP7).Value num8 = Cells(linE, colP8).Value For num9 = num8 + 1 To 25 colM9 = num9 + 2 afim = Application.WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5, rm(num6), num6, _ rm(num7), num7, rm(num8), num8, _ rm(num9), num9) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colP9).Value = num9 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Cells(linE, colP1).Value = 0 Cells(linE, colP2).Value = 0 Cells(linE, colP3).Value = 0 Cells(linE, colP4).Value = 0 Cells(linE, colP5).Value = 0 Cells(linE, colP6).Value = 0 Cells(linE, colP7).Value = 0 Cells(linE, colP8).Value = 0 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colP9).Value = num9 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num9 Next linE '---------Pesquisa de 10 lin9 = linR For linE = lin8 + 1 To lin9 num1 = Cells(linE, colP1).Value num2 = Cells(linE, colP2).Value num3 = Cells(linE, colP3).Value num4 = Cells(linE, colP4).Value num5 = Cells(linE, colP5).Value num6 = Cells(linE, colP6).Value num7 = Cells(linE, colP7).Value num8 = Cells(linE, colP8).Value num9 = Cells(linE, colP9).Value For num10 = num9 + 1 To 25 colM10 = num10 + 2 afim = Application.WorksheetFunction.CountIfs(rm(num1), num1, rm(num2), num2, _ rm(num3), num3, rm(num4), num4, _ rm(num5), num5, rm(num6), num6, _ rm(num7), num7, rm(num8), num8, _ rm(num9), num9) If afim <> 0 Then Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colP9).Value = num9 Cells(linR, colP10).Value = num10 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 afim = 0 linR = linR + 1 Cells(linE, colP1).Value = 0 Cells(linE, colP2).Value = 0 Cells(linE, colP3).Value = 0 Cells(linE, colP4).Value = 0 Cells(linE, colP5).Value = 0 Cells(linE, colP6).Value = 0 Cells(linE, colP7).Value = 0 Cells(linE, colP8).Value = 0 Cells(linE, colP9).Value = 0 Else Cells(linR, colP1).Value = num1 Cells(linR, colP2).Value = num2 Cells(linR, colP3).Value = num3 Cells(linR, colP4).Value = num4 Cells(linR, colP5).Value = num5 Cells(linR, colP6).Value = num6 Cells(linR, colP7).Value = num7 Cells(linR, colP8).Value = num8 Cells(linR, colP9).Value = num9 Cells(linR, colP10).Value = num10 Cells(linR, colR).Value = afim Cells(linR, colR + 1).Value = lin2 End If Next num10 Next linE End Sub Alguém pode me ajudar ?