Alteração de registros substituindo linha errada

[Michelle Alves]

Bom dia,

Tentei utilizar um procedimento que executo em diversos locais do meu projeto, porém dessa vez ele falhou. Ao invés de alterar, ele tá substituindo os dados errados. Por exemplo: Se a linha que deveria ser substituída era a linha 10, ele substitue a linha 5. Penso que seria porque praticamente todas os dados são iguais, exceto pela data. Posto abaixo o procedimento, quem souber me informar qual seria o problema, ficarei muito grata.

Private Sub CMDalterar_Click()

Dim Resposta

Dim i As Double

i = (ListBox1.ListIndex + 5)

Resposta = MsgBox("Tem certeza que deseja efetuar essa alteração?", vbYesNo)

If Resposta = vbYes And i >= 5 Then

With Sheets("CREC")

.Cells(i, 2) = CDate(TextBox2.Text)

.Cells(i, 3) = TextBox3.Text

.Cells(i, 4) = TextBox4.Text

.Cells(i, 5) = TextBox5.Text

.Cells(i, 6) = TextBox1.Text

.Cells(i, 7) = TextBox8.Text

.Cells(i, 8) = TextBox6.Text

.Cells(i, 9) = TextBox7.Text

.Cells(i, 10) = CCur(TextBox9.Text)

.Cells(i, 11) = CCur(TextBox10.Text)

.Cells(i, 12) = CDate(TextBox11.Text)

.Cells(i, 13) = CCur(TextBox14.Text)

.Cells(i, 14) = CDate(TextBox15.Text)

End With

End If

End Sub

[kuroi]

michelle, o q tem no listbox??

o listindex retorna a linha selecionada no listbox. se ele ta mudando a linha 5, é porque você ta na primera linha do listbox não é isso??

[Michelle Alves]

Teoricamente sim, Kuroi. A alteração procede ao dar um duplo click no item do List e ecaminhar para as TEXT. Porém, a maioria dos dados são iguais, e na hora de efetuar a alteração, o primeiro item com dados iguais ao que selecionei é alterado, ou seja, como lido com dados praticamente iguais, nem sempre aquele que selecionei é o que será alterado, mas sim um que venha primeiro e tenha dados iguais ao que eu selecionei.

[kuroi]

aiaiai michelle ta dificil de entender.

quer mandar a planilha??

[Michelle Alves]

É complicado mesmo Kuroi, mas te mando sim. Prefere que te mande por email ou coloque num HD virtual ?

Editado Maio 3, 2009 por Michelle Alves

[kuroi]

a tanto faz, hospeda em algum servidor como você fazia.

[Michelle Alves]

Tá feito então, qualquer dúvida fique à vontade pra me perguntar:

http://www.4shared.com/account/file/103227...EC_alterao.html

Obrigada novamente

[kuroi]

michelle, ta dizendo:

The file link that you requested is not valid.

quer mandar no meu email rafaelsposito[arroba]gmail.com ??

[Michelle Alves]

Enviei agora Kuroi.

Obrigada e boa noite

[kuroi]

michelle, se o numero do pedido vai estar no textbox1, não é so você fazer um find na coluna F (onde estao os numeros)?? tipo assim:

Private Sub CMDalterar_Click()
    Dim x As Range, i As Double
    
    Set x = Worksheets("CREC").Range("F:F").Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        
    If Not x Is Nothing Then
        i = x.Row
        
        With Worksheets("CREC")
            .Cells(i, 2) = valor
            ....
            ....
            .Cells(i, 13) = valor
            .Cells(i, 14) = valor
        End With
    End If
End Sub[/code]

[Michelle Alves]

É Kuroi... em princípio parece isso...rs. Mas o problema é que podem ter valores iguais na coluna F, então ele precisa verificar em duas colunas, na F e na L, TEXT1 e TEXT11, compreendeu ?

[kuroi]

o então acho q isso ai resolve:

Private Sub CMDalterar_Click()
    Dim x As Range, i As Integer
    
    Set x = Worksheets("CREC").Range("F:F").Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        
    Do While Not x Is Nothing
        i = x.Row
        
        If Worksheets("CREC").Cells(i, 12) = TextBox11.Text Then Exit Do
        
        x = Worksheets("CREC").Range("F:F").FindNext(x)
    Loop
            
    If Not x Is Nothing Then
        With Worksheets("CREC")
            .Cells(i, 2) = valor
            ....
            ....
            .Cells(i, 13) = valor
            .Cells(i, 14) = valor
        End With
    End If
End Sub[/code]

[Michelle Alves]

Então kuroi, deu incompatibilidade na linha abaixo:

Set x = Worksheets("CREC").Range("F:F").Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False)

Abaixo coloco o procedimento completo que utilizei:

Private Sub CMDalterar_Click()

Dim x As Range, i As Integer

Set x = Worksheets("CREC").Range("F:F").Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False)

Do While Not x Is Nothing

i = x.Row

If Worksheets("CREC").Cells(i, 12) = TextBox11.Text Then Exit Do

x = Worksheets("CREC").Range("F:F").FindNext(x)

Loop

If Not x Is Nothing Then

With Worksheets("CREC")

.Cells(i, 13) = TextBox15.Text

.Cells(i, 14) = TextBox14.Text

End With

End If

End Sub

Editado Maio 6, 2009 por Michelle Alves

[kuroi]

incompatibilidade?? mas qual a mensagem do erro??

tente isso:

Set x = Worksheets("CREC").Range("F:F").Find(What:=Val(TextBox1.Text), After:=ActiveCell, LookIn:=xlValues, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False)

[Michelle Alves]

Então, vou repetir a mensagem aqui:

Erro em tempo de execução '13':

Tipos incompatíveis

Inclusive com a nova versão deu o mesmo erro.

Obrigada Kuroi

[kuroi]

michelle, ainda esta com o problema??

então, esse erro ocorre naquela linha mesmo??

não é na q procura na coluna L não??

você tentou o Val() como eu passei??

o q acontece, é a coluna F ta preenchida com numeros. não pode ter texto no textbox1 na hora de fazer a busca senao vai dar erro mesmo. tem q ter um numero la.

[Michelle Alves]

Então Kuroi, pior que estou com o problema até hoje. Tentei exatamente como você falou... e deu o mesmo erro.

Coloquei o Val do mesmo jeito. O valor exibido no Textbox1 é puxado da planilha e ele não sofre alteração.

Só lembrando, a busca seria:o TExtbox1 na coluna F e Textbox11 na coluna L. Ai uma vez que encontrou promove nessa linha a alteração.

Compreendeu ?

Obrigado, viu.

[kuroi]

michelle, na planilha q você me mandou esse codigo funcionou certinho com o dado q tava no textbox.

quer mandar de novo com as alteracoes q você fez??

[Michelle Alves]

Kuroi, te enviei novamente no teu email, ok. Tente fazer como expliquei no email, por favor. Aqui não roda de jeito nenhum.

Obrigada.

[kuroi]

michelle, olha q agora deve resolver:

Private Sub CMDalterar_Click()

Dim x As Range, i As Integer

Set x = Worksheets("CREC").Range("F:F").Find(What:=TextBox1.Text, After:=Worksheets("CREC").Range("F5"), LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

Do While Not x Is Nothing
i = x.Row

If CDate(Worksheets("CREC").Cells(i, 12)) = CDate(TextBox11.Text) Then Exit Do

Set x = Worksheets("CREC").Range("F:F").FindNext(After:=x)
Loop

If Not x Is Nothing Then
With Worksheets("CREC")
.Cells(i, 13) = TextBox15.Text
.Cells(i, 14) = TextBox14.Text
End With
End If
End Sub[/code]

[Michelle Alves]

Ufa......agora sim, Kuroi... nem acredito...rs.

Isso já tava me deixando preocupada, muitíssimo obrigada !!!

Editado Maio 14, 2009 por Michelle Alves

[Michelle Alves]

Kuroi,

Sem querer abusar, mas abusando... e para realizar essa mesma busca pelos dois TEXT. TEXTBOX1 E TEXTBOX11, mas ao invés de alterar eu copiar a linha localizada para outra planilha e deletar a linha selecionada. Como eu poderia fazer ?

Obrigada

[kuroi]

michelle, você poderia recortar a linha assim:

If Not x Is Nothing Then
    x.EntireRow.Cut
    Sheets("Plan1").Paste
End If[/code]
mas ai acho q depois você teria q subir as linhas de baxo ne??

[Michelle Alves]

Realmente Kuroi,

Já até consegui, mas sua forma ficou mais simples. Só não vai atualizar o item deletado, né.... Veja só:

If Not x Is Nothing Then

Sheets("CREC").Activate

Set rgOrigem = Sheets("CREC").Range("B" & i & ":N" & i)

Lastrow = Sheets("BAIXA").Cells(Rows.Count, 2).End(xlUp).Row

If Lastrow < 3 Then Lastrow = 3

rgOrigem.Copy Sheets("BAIXA").Range("B" & Lastrow + 1)

rgOrigem.EntireRow.Delete

End If

MSGBOX "Registro baixado com sucesso"

ListBox1.Object.Clear