Ir para conteúdo
Fórum Script Brasil
  • 0

Alteração de registros substituindo linha errada


Michelle Alves

Pergunta

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

Link para o comentário
Compartilhar em outros sites

23 respostass a esta questão

Posts Recomendados

  • 0

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.

Link para o comentário
Compartilhar em outros sites

  • 0

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]

Link para o comentário
Compartilhar em outros sites

  • 0

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]

Link para o comentário
Compartilhar em outros sites

  • 0

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 por Michelle Alves
Link para o comentário
Compartilhar em outros sites

  • 0

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)

Link para o comentário
Compartilhar em outros sites

  • 0

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.

Link para o comentário
Compartilhar em outros sites

  • 0

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.

Link para o comentário
Compartilhar em outros sites

  • 0

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]

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...