[Resolvido]erro em consulta vba

Boa noite,

Alguem consegue me dizer aonde está o erro dessa consulta abaixo? ela pega dados de uma tabela e joga em uma listbox cheia de colunas. Porem quando clico no botão os dados não são filtrados pela data, e some tudo e a lista com 19 colunas fica em branco.


Private Sub btnMes_Click()
Dim StrSQL As String, StrSQL1 As String


If IsNull(DataInicial) = True Or Me.DataInicial = "" Or IsNull(DataFinal) = True Or Me.DataFinal = "" Then
MsgBox "é obrigatório o preenchimento dos campos Data Inicial e Data Final" & vbCrLf & _
"para efetuar a consulta", vbCritical, "Atençao!"
Exit Sub
Else
If Me.btnMes.Caption = "Filtrar" Then
If Format(Me.DataInicial, "dd/mm/yyyy") > Format(Me.DataFinal, "dd/mm/yyyy") Then
MsgBox "A Data Inicial não pode ser menor que a Data Final", vbCritical, "Atenção!"
Exit Sub
Else
Me.btnMes.Caption = "Filtrado"
Me.btnMes.ForeColor = vbRed
StrSQL = "SELECT tabCondenasp.ID_CodCondenasparciais, tabCondenasp.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabCondenasp.CpTipo AS TIPO," _
& "tabCondenasp.CpAbcesso AS ABCESSO, tabCondenasp.CpAerosacolite AS AEROSACULITE," _
& "tabCondenasp.CpArtrite AS ARTRITE, tabCondenasp.CpAscite AS ASCITE," _
& "tabCondenasp.CpCaquexia AS CAQUEXIA,tabCondenasp.CpCelulite AS CELULITE," _
& "tabCondenasp.CpColigranulatose AS COLIGRANULATOSE, tabCondenasp.CpContaminacao AS CONTAMINAÇÃO," _
& "tabCondenasp.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabCondenasp.CpDermatose AS DERMATOSE," _
& "tabCondenasp.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA], tabCondenasp.CpMaSangria AS [MA SANGRIA]," _
& "tabCondenasp.CpSalpingite AS SALPINGITE, tabCondenasp.Cpdoeca1 AS [DOENCA 1]," _
& "tabCondenasp.Cpdoeca2 AS [DOENCA 2]," _
& "FROM tabgranjas LEFT JOIN tabCondenasp ON tabgranjas.ID_Granja = tabCondenasp.ID_Granja" _
& " WHERE (((tabCondenasp.ID_CodCondenasparciais) Is Not Null)) And ((tabCondenasp.CpData >=#" & Format(Me.DataInicial, "mm/dd/yyyy") & "#) And (tabCondenasp.CpData <=#" & Format(Me.DataFinal, "mm/dd/yyyy") & "#))"
If Me.CboGranja <> "" Then
StrSQL = StrSQL & " And tabCondenasp.ID_Granja =" & Me.txtGranja & ""
End If
If Me.CboTipoAve <> "" Then
StrSQL = StrSQL & " And tabCondenasp.CpTipo ='" & Me.CboTipoAve & "'"
End If
StrSQL = StrSQL & " ORDER BY tabCondenasp.CpData;"
Me.lstConsulta.RowSource = StrSQL
Call AplicarCalculos

End If
Else
Call LimpaFiltro
Me.txtAviso.Visible = False

Me.btnMes.Caption = "Filtrar"
Me.btnMes.ForeColor = vbBlack
End If
End If
If Me.txtQtdReg = -1 Then
MsgBox "Não foi encontrado registro para esta consulta!", vbInformation, "Atenção"
Me.txtAviso.Visible = True
End If
End Sub

----------------------------------------------------------------
Sub LimpaFiltro()
Dim StrSQLLimpa As String

StrSQLLimpa = "SELECT tabCondenasp.ID_CodCondenasparciais, tabCondenasp.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabCondenasp.CpTipo AS TIPO," _
& "tabCondenasp.CpAbcesso AS ABCESSO, tabCondenasp.CpAerosacolite AS AEROSACULITE," _
& "tabCondenasp.CpArtrite AS ARTRITE, tabCondenasp.CpAscite AS ASCITE," _
& "tabCondenasp.CpCaquexia AS CAQUEXIA, tabCondenasp.CpCelulite AS CELULITE," _
& "tabCondenasp.CpColigranulatose AS COLIGRANULATOSE, tabCondenasp.CpContaminacao AS CONTAMINAÇÃO," _
& "tabCondenasp.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabCondenasp.CpDermatose AS DERMATOSE," _
& "tabCondenasp.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA], tabCondenasp.CpMaSangria AS [MA SANGRIA]," _
& "tabCondenasp.CpSalpingite AS SALPINGITE, tabCondenasp.Cpdoeca1 AS [DOENCA 1]," _
& "tabCondenasp.Cpdoeca2 AS [DOENCA 2]," _
& "FROM tabgranjas LEFT JOIN tabCondenasp ON tabgranjas.ID_Granja = tabCondenasp.ID_Granja" _
& " WHERE (((tabCondenasp.ID_CodCondenasparciais) Is Not Null));"
Me.lstConsulta.RowSource = StrSQLLimpa
Me.DataInicial = ""
Me.DataFinal = ""
Me.CboTipoAve = ""
Me.CboGranja = ""
Me.txtGranja = ""
Call AplicarCalculos
End Sub

Disponibilize uma parte do bd para melhor compreender o que esta acontesento amigo

Não sei mandar so uma parte, e o banco completo para enviar e grande demais.

Boa tarde, thiagojos

Coloque o texto SQL, substituindo as variáveis por valores de exemplo, e crie uma consulta para ver se devolve o resultado pretendido. Se funcionar na consulta, o texto SQL está correcto e verifique se não existe código seguinte que limpe a Caixa de listagem.
No entanto:
1 - O texto
StrSQL = StrSQL & " And tabCondenasp.ID_Granja =" & Me.txtGranja & ""
é igual a
StrSQL = StrSQL & " And tabCondenasp.ID_Granja =" & Me.txtGranja
2 - Neste código, CpTipo é considerado texto. É mesmo assim?
StrSQL = StrSQL & " And tabCondenasp.CpTipo ='" & Me.CboTipoAve & "'"

Boa noite alexandre,

Abaixo o codigo atual de outro form que funciona a consulta vba certinho. Dai copiei o form, mudei o nome, alterei o codigo vba para outra tabela, e campos, e agora esta dando erro, porem estão identicos, abaixo segue o codigo que funciona.


Option Compare Database
Option Explicit

Private Sub btnRelatorio_Click()
Me.Visible = False
DoCmd.OpenReport "rptcondenas", acViewPreview
End Sub

Private Sub Lista65_AfterUpdate()
' Localizar o registo que corresponde ao controlo.
Dim rs As Object

Set rs = Me.Recordset.Clone
rs.FindFirst "[ID_CodCondenas] = " & (Nz(Me![Lista65], 1))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


Private Sub nome_AfterUpdate()
Me.Lista65.Requery
End Sub


Private Sub nome_Change()
Me.Recalc
SendKeys "{F2}"
End Sub

Private Sub btnMes_Click()
Dim StrSQL As String, StrSQL1 As String


If IsNull(DataInicial) = True Or Me.DataInicial = "" Or IsNull(DataFinal) = True Or Me.DataFinal = "" Then
MsgBox "é obrigatório o preenchimento dos campos Data Inicial e Data Final" & vbCrLf & _
"para efetuar a consulta", vbCritical, "Atençao!"
Exit Sub
Else
If Me.btnMes.Caption = "Filtrar" Then
If Format(Me.DataInicial, "dd/mm/yyyy") > Format(Me.DataFinal, "dd/mm/yyyy") Then
MsgBox "A Data Inicial não pode ser menor que a Data Final", vbCritical, "Atenção!"
Exit Sub
Else
Me.btnMes.Caption = "Filtrado"
Me.btnMes.ForeColor = vbRed
StrSQL = "SELECT tabCondenasTotais.ID_CodCondenas, tabCondenasTotais.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabCondenasTotais.CpTipo AS TIPO," _
& "tabCondenasTotais.CpAbcesso AS ABCESSO, tabCondenasTotais.CpAerosacolite AS AEROSACULITE," _
& "tabCondenasTotais.CpArtrite AS ARTRITE, tabCondenasTotais.CpAscite AS ASCITE," _
& "tabCondenasTotais.CpAspectoRepugnante AS [ASPECTO REPUGNANTE], tabCondenasTotais.CpCaquexia AS CAQUEXIA," _
& "tabCondenasTotais.CpCelulite AS CELULITE, tabCondenasTotais.CpColibacilose AS COLIBACILOSE," _
& "tabCondenasTotais.CpColigranulatose AS COLIGRANULATOSE, tabCondenasTotais.CpContaminacao AS CONTAMINAÇÃO," _
& "tabCondenasTotais.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabCondenasTotais.CpDermatose AS DERMATOSE," _
& "tabCondenasTotais.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA]," _
& "tabCondenasTotais.CpEvisceracaoRetardada AS [EVISCERAÇÃO RETARDADA]," _
& "tabCondenasTotais.CpMarek AS MAREK, tabCondenasTotais.CpMaSangria AS [MA SANGRIA]," _
& "tabCondenasTotais.CpNeolplasia AS NEOPLASIA, tabCondenasTotais.CpSalpingite AS SALPINGITE," _
& "tabCondenasTotais.CpSepticemia AS SEPTICEMIA, tabCondenasTotais.CpSindromeHemorragica AS [SINDROME HEMORRAGICA]," _
& "tabCondenasTotais.CpTumores AS TUMORES, tabCondenasTotais.Cpdoeca1 AS [DOENCA 1]," _
& "tabCondenasTotais.Cpdoeca2 AS [DOENCA 2], tabCondenasTotais.Cpdoeca3 AS [DOENCA 3]," _
& "tabCondenasTotais.Cpdoeca4 AS [DOENCA 4], tabCondenasTotais.Cpdoeca5 AS [DOENCA 5]" _
& " FROM tabgranjas LEFT JOIN tabCondenasTotais ON tabgranjas.ID_Granja = tabCondenasTotais.ID_Granja" _
& " WHERE (((tabCondenasTotais.ID_CodCondenas) Is Not Null)) And ((tabCondenasTotais.CpData >=#" & Format(Me.DataInicial, "mm/dd/yyyy") & "#) And (tabCondenasTotais.CpData <=#" & Format(Me.DataFinal, "mm/dd/yyyy") & "#))"
If Me.CboGranja <> "" Then
StrSQL = StrSQL & " And tabCondenasTotais.ID_Granja =" & Me.txtGranja & ""
End If
If Me.CboTipoAve <> "" Then
StrSQL = StrSQL & " And tabCondenasTotais.CpTipo ='" & Me.CboTipoAve & "'"
End If
StrSQL = StrSQL & " ORDER BY tabCondenasTotais.CpData;"
Me.lstConsulta.RowSource = StrSQL
Call AplicarCalculos

End If
Else
Call LimpaFiltro
Me.txtAviso.Visible = False

Me.btnMes.Caption = "Filtrar"
Me.btnMes.ForeColor = vbBlack
End If
End If
If Me.txtQtdReg = -1 Then
MsgBox "Não foi encontrado registro para esta consulta!", vbInformation, "Atenção"
Me.txtAviso.Visible = True
End If
End Sub


Private Sub CboGranja_AfterUpdate()
Me.txtGranja = Me.CboGranja.Column(0)
End Sub

Private Sub CboGranja_Change()
Me.CboTipoAve.SetFocus
End Sub

Private Sub Comando23_Click()
DoCmd.Close
End Sub


Sub LimpaFiltro()
Dim StrSQLLimpa As String

StrSQLLimpa = "SELECT tabCondenasTotais.ID_CodCondenas, tabCondenasTotais.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabCondenasTotais.CpTipo AS TIPO," _
& "tabCondenasTotais.CpAbcesso AS ABCESSO, tabCondenasTotais.CpAerosacolite AS AEROSACULITE," _
& "tabCondenasTotais.CpArtrite AS ARTRITE, tabCondenasTotais.CpAscite AS ASCITE," _
& "tabCondenasTotais.CpAspectoRepugnante AS [ASPECTO REPUGNANTE], tabCondenasTotais.CpCaquexia AS CAQUEXIA," _
& "tabCondenasTotais.CpCelulite AS CELULITE, tabCondenasTotais.CpColibacilose AS COLIBACILOSE," _
& "tabCondenasTotais.CpColigranulatose AS COLIGRANULATOSE, tabCondenasTotais.CpContaminacao AS CONTAMINAÇÃO," _
& "tabCondenasTotais.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabCondenasTotais.CpDermatose AS DERMATOSE," _
& "tabCondenasTotais.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA]," _
& "tabCondenasTotais.CpEvisceracaoRetardada AS [EVISCERAÇÃO RETARDADA]," _
& "tabCondenasTotais.CpMarek AS MAREK, tabCondenasTotais.CpMaSangria AS [MA SANGRIA]," _
& "tabCondenasTotais.CpNeolplasia AS NEOPLASIA, tabCondenasTotais.CpSalpingite AS SALPINGITE," _
& "tabCondenasTotais.CpSepticemia AS SEPTICEMIA, tabCondenasTotais.CpSindromeHemorragica AS [SINDROME HEMORRAGICA]," _
& "tabCondenasTotais.CpTumores AS TUMORES, tabCondenasTotais.Cpdoeca1 AS [DOENCA 1]," _
& "tabCondenasTotais.Cpdoeca2 AS [DOENCA 2], tabCondenasTotais.Cpdoeca3 AS [DOENCA 3]," _
& "tabCondenasTotais.Cpdoeca4 AS [DOENCA 4], tabCondenasTotais.Cpdoeca5 AS [DOENCA 5]" _
& " FROM tabgranjas LEFT JOIN tabCondenasTotais ON tabgranjas.ID_Granja = tabCondenasTotais.ID_Granja" _
& " WHERE (((tabCondenasTotais.ID_CodCondenas) Is Not Null));"
Me.lstConsulta.RowSource = StrSQLLimpa
Me.DataInicial = ""
Me.DataFinal = ""
Me.CboTipoAve = ""
Me.CboGranja = ""
Me.txtGranja = ""
Call AplicarCalculos
End Sub

Private Sub DataFinal_Change()
Me.CboGranja.SetFocus
End Sub



Sub AplicarCalculos()
Me.txtAbcesso.Value = SomaColuna(4)
Me.txtaero.Value = SomaColuna(5)
Me.txtartr.Value = SomaColuna(6)
Me.txtasci.Value = SomaColuna(7)
Me.txtasre.Value = SomaColuna(
Me.txtcaqu.Value = SomaColuna(9)
Me.txtcelu.Value = SomaColuna(10)
Me.txtcoli.Value = SomaColuna(11)
Me.txtcolig.Value = SomaColuna(12)
Me.txtcont.Value = SomaColuna(13)
Me.txtcofr.Value = SomaColuna(14)
Me.txtderm.Value = SomaColuna(15)
Me.txtesex.Value = SomaColuna(16)
Me.txtevre.Value = SomaColuna(17)
Me.txtmare.Value = SomaColuna(18)
Me.txtmasa.Value = SomaColuna(19)
Me.txtneop.Value = SomaColuna(20)
Me.txtsalp.Value = SomaColuna(21)
Me.txtsept.Value = SomaColuna(22)
Me.txtsihe.Value = SomaColuna(23)
Me.txttumo.Value = SomaColuna(24)
Me.txtdo1.Value = SomaColuna(25)
Me.txtdo2.Value = SomaColuna(26)
Me.txtdo3.Value = SomaColuna(27)
Me.txtdo4.Value = SomaColuna(28)
Me.txtdo5.Value = SomaColuna(29)
End Sub

Private Sub NumMin()
Dim L As Double
Dim Min

Min = Me.lstConsulta.Column(12, 1)

For L = 0 To Me.lstConsulta.ListCount - 1
If Me.lstConsulta.Column(12, L) < Min Then
Min = Me.lstConsulta.Column(12, L)
End If
Next
Me.txtMin = Format(Min, "#,##0.00")
End Sub

Private Sub NumMax()
Dim L As Double
Dim Max

Max = Me.lstConsulta.Column(12, 1)

For L = 1 To Me.lstConsulta.ListCount - 1
If Me.lstConsulta.Column(12, L) > Max Then
Max = Me.lstConsulta.Column(12, L)
End If
Next
Me.txtMax = Format(Max, "#,##0.00")
End Sub

Private Function fncDesvio(N As Double) As Double
Dim k, j As Long, seq As String, media As Double, soma As Double

If Me!lstConsulta.ListCount < 2 Then
Exit Function
End If
If Me!lstConsulta.ListCount = 2 Then
fncDesvio = Me!lstConsulta.Column(N, 1)
Exit Function
End If

For j = 1 To Me!lstConsulta.ListCount - 1: seq = seq & Me!lstConsulta.Column(N, j) & "~": Next
seq = Left(seq, Len(seq) - 1)
k = Split(seq, "~")
For j = 0 To UBound(k): soma = soma + k(j): Next
media = soma / (Me!lstConsulta.ListCount - 1)
soma = 0
For j = 0 To UBound(k): soma = soma + ((media - k(j)) ^ 2): Next
fncDesvio = Sqr(soma / (Me!lstConsulta.ListCount - 2))
End Function


Function SomaColuna(Y As Integer)
On Error Resume Next
Dim X, soma
Dim StrTeste
soma = 0
For X = 1 To Me.lstConsulta.ListCount - 1
soma = soma + Me.lstConsulta.Column(Y, X)
Next
SomaColuna = soma
End Function


Private Sub Form_Load()
Call AplicarCalculos
Me.txtAviso.Visible = False
End Sub

Agora aqui ja o codigo alterado para outra tabela. Porem não sei por que dar erro, sendo que estão parecidos e a unica diferença foi que eu tirei campos.


Option Compare Database
Option Explicit

Private Sub btnRelatorio_Click()
Me.Visible = False
DoCmd.OpenReport "rptcondenas", acViewPreview
End Sub



Private Sub nome_Change()
Me.Recalc
SendKeys "{F2}"
End Sub

Private Sub btnMes_Click()
Dim StrSQL As String, StrSQL1 As String


If IsNull(DataInicial) = True Or Me.DataInicial = "" Or IsNull(DataFinal) = True Or Me.DataFinal = "" Then
MsgBox "é obrigatório o preenchimento dos campos Data Inicial e Data Final" & vbCrLf & _
"para efetuar a consulta", vbCritical, "Atençao!"
Exit Sub
Else
If Me.btnMes.Caption = "Filtrar" Then
If Format(Me.DataInicial, "dd/mm/yyyy") > Format(Me.DataFinal, "dd/mm/yyyy") Then
MsgBox "A Data Inicial não pode ser menor que a Data Final", vbCritical, "Atenção!"
Exit Sub
Else
Me.btnMes.Caption = "Filtrado"
Me.btnMes.ForeColor = vbRed
StrSQL = "SELECT tabcondenasp.ID_CodCondenas, tabcondenasp.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabcondenasp.CpTipo AS TIPO," _
& "tabcondenasp.CpAbcesso AS ABCESSO, tabcondenasp.CpAerosacolite AS AEROSACULITE," _
& "tabcondenasp.CpArtrite AS ARTRITE, tabcondenasp.CpAscite AS ASCITE," _
& "tabcondenasp.CpCaquexia AS CAQUEXIA, tabcondenasp.CpCelulite AS CELULITE," _
& "tabcondenasp.CpContaminacao AS CONTAMINAÇÃO," _
& "tabcondenasp.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabcondenasp.CpDermatose AS DERMATOSE," _
& "tabcondenasp.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA]," _
& "tabcondenasp.CpMaSangria AS [MA SANGRIA], tabcondenasp.CpSalpingite AS SALPINGITE," _
& "tabcondenasp.Cpdoeca1 AS [DOENCA 1], tabcondenasp.Cpdoeca2 AS [DOENCA 2]," _
& " FROM tabgranjas LEFT JOIN tabcondenasp ON tabgranjas.ID_Granja = tabcondenasp.ID_Granja" _
& " WHERE (((tabcondenasp.ID_CodCondenas) Is Not Null)) And ((tabcondenasp.CpData >=#" & Format(Me.DataInicial, "mm/dd/yyyy") & "#) And (tabcondenasp.CpData <=#" & Format(Me.DataFinal, "mm/dd/yyyy") & "#))"
If Me.CboGranja <> "" Then
StrSQL = StrSQL & " And tabcondenasp.ID_Granja =" & Me.txtGranja & ""
End If
If Me.CboTipoAve <> "" Then
StrSQL = StrSQL & " And tabcondenasp.CpTipo ='" & Me.CboTipoAve & "'"
End If
StrSQL = StrSQL & " ORDER BY tabcondenasp.CpData;"
Me.lstConsulta1.RowSource = StrSQL
Call AplicarCalculos

End If
Else
Call LimpaFiltro
Me.txtAviso.Visible = False

Me.btnMes.Caption = "Filtrar"
Me.btnMes.ForeColor = vbBlack
End If
End If
If Me.txtQtdReg = -1 Then
MsgBox "Não foi encontrado registro para esta consulta!", vbInformation, "Atenção"
Me.txtAviso.Visible = True
End If
End Sub


Private Sub CboGranja_AfterUpdate()
Me.txtGranja = Me.CboGranja.Column(0)
End Sub

Private Sub CboGranja_Change()
Me.CboTipoAve.SetFocus
End Sub

Private Sub Comando23_Click()
DoCmd.Close
End Sub


Sub LimpaFiltro()
Dim StrSQLLimpa As String

StrSQLLimpa = "SELECT tabcondenasp.ID_CodCondenas, tabcondenasp.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabcondenasp.CpTipo AS TIPO," _
& "tabcondenasp.CpAbcesso AS ABCESSO, tabcondenasp.CpAerosacolite AS AEROSACULITE," _
& "tabcondenasp.CpArtrite AS ARTRITE, tabcondenasp.CpAscite AS ASCITE," _
& "tabcondenasp.CpCaquexia AS CAQUEXIA, tabcondenasp.CpCelulite AS CELULITE," _
& "tabcondenasp.CpContaminacao AS CONTAMINAÇÃO," _
& "tabcondenasp.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabcondenasp.CpDermatose AS DERMATOSE," _
& "tabcondenasp.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA]," _
& "tabcondenasp.CpMaSangria AS [MA SANGRIA], tabcondenasp.CpSalpingite AS SALPINGITE," _
& "tabcondenasp.Cpdoeca1 AS [DOENCA 1], tabcondenasp.Cpdoeca2 AS [DOENCA 2]," _
& " FROM tabgranjas LEFT JOIN tabcondenasp ON tabgranjas.ID_Granja = tabcondenasp.ID_Granja" _
& " WHERE (((tabcondenasp.ID_CodCondenas) Is Not Null));"
Me.lstConsulta1.RowSource = StrSQLLimpa
Me.DataInicial = ""
Me.DataFinal = ""
Me.CboTipoAve = ""
Me.CboGranja = ""
Me.txtGranja = ""
Call AplicarCalculos
End Sub

Private Sub DataFinal_Change()
Me.CboGranja.SetFocus
End Sub



Sub AplicarCalculos()
Me.txtAbcesso.Value = SomaColuna(4)
Me.txtaero.Value = SomaColuna(5)
Me.txtartr.Value = SomaColuna(6)
Me.txtasci.Value = SomaColuna(7)
Me.txtasre.Value = SomaColuna(
Me.txtcaqu.Value = SomaColuna(9)
Me.txtcelu.Value = SomaColuna(10)
Me.txtcoli.Value = SomaColuna(11)
Me.txtcolig.Value = SomaColuna(12)
Me.txtcont.Value = SomaColuna(13)
Me.txtcofr.Value = SomaColuna(14)
Me.txtderm.Value = SomaColuna(15)
Me.txtesex.Value = SomaColuna(16)
Me.txtevre.Value = SomaColuna(17)
Me.txtmare.Value = SomaColuna(18)
Me.txtmasa.Value = SomaColuna(19)
Me.txtneop.Value = SomaColuna(20)
Me.txtsalp.Value = SomaColuna(21)
Me.txtsept.Value = SomaColuna(22)
Me.txtsihe.Value = SomaColuna(23)
Me.txttumo.Value = SomaColuna(24)
Me.txtdo1.Value = SomaColuna(25)
Me.txtdo2.Value = SomaColuna(26)
Me.txtdo3.Value = SomaColuna(27)
Me.txtdo4.Value = SomaColuna(28)
Me.txtdo5.Value = SomaColuna(29)
End Sub

Private Sub NumMin()
Dim L As Double
Dim Min

Min = Me.lstConsulta1.Column(12, 1)

For L = 0 To Me.lstConsulta1.ListCount - 1
If Me.lstConsulta1.Column(12, L) < Min Then
Min = Me.lstConsulta1.Column(12, L)
End If
Next
Me.txtMin = Format(Min, "#,##0.00")
End Sub

Private Sub NumMax()
Dim L As Double
Dim Max

Max = Me.lstConsulta1.Column(12, 1)

For L = 1 To Me.lstConsulta1.ListCount - 1
If Me.lstConsulta1.Column(12, L) > Max Then
Max = Me.lstConsulta1.Column(12, L)
End If
Next
Me.txtMax = Format(Max, "#,##0.00")
End Sub

Private Function fncDesvio(N As Double) As Double
Dim k, j As Long, seq As String, media As Double, soma As Double

If Me!lstConsulta1.ListCount < 2 Then
Exit Function
End If
If Me!lstConsulta1.ListCount = 2 Then
fncDesvio = Me!lstConsulta1.Column(N, 1)
Exit Function
End If

For j = 1 To Me!lstConsulta1.ListCount - 1: seq = seq & Me!lstConsulta1.Column(N, j) & "~": Next
seq = Left(seq, Len(seq) - 1)
k = Split(seq, "~")
For j = 0 To UBound(k): soma = soma + k(j): Next
media = soma / (Me!lstConsulta1.ListCount - 1)
soma = 0
For j = 0 To UBound(k): soma = soma + ((media - k(j)) ^ 2): Next
fncDesvio = Sqr(soma / (Me!lstConsulta1.ListCount - 2))
End Function


Function SomaColuna(Y As Integer)
On Error Resume Next
Dim X, soma
Dim StrTeste
soma = 0
For X = 1 To Me.lstConsulta1.ListCount - 1
soma = soma + Me.lstConsulta1.Column(Y, X)
Next
SomaColuna = soma
End Function


Private Sub Form_Load()
Call AplicarCalculos
Me.txtAviso.Visible = False
End Sub

Estou a puxar o tópico para cima. se já tiver resolvido, agradeço o seu retorno.

Bom dia Vieira,

Não consegui resolver, estou parado a uma semana o projeto por causa disso.

Obrigado,

Vou ter que dar este tópico por resolvido. Se necessário, abra um novo tópico.