UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo


No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

AlexGlez


Hola Buenas Noches tengo el siguiente formulario en cual los datos capturados se guardan en la hoja 2, el problema es que en los combobox y textbox de estatus y montos al guárdalos me duplica la información,(el problema esta en la parte en color naranjadel código), lo cual no debiera de suceder espero puedan ayudar me  a solucionarlo por favor; el código es el siguiente:


Private Sub UserForm_Initialize()
On Error Resume Next
With Sheets("Datos Aplicativo")
For a = 0 To .[a1000000].End(xlUp).Row
ComboBox1.AddItem
ComboBox1.List(a, 0) = .Cells(a + 1, 1)
ComboBox1.List(a, 1) = .Cells(a + 1, 2)
Next a
End With
Call actualizar_grilla_registros
End Sub


Private Sub CommandButton1_Click() 'grabar
Dim carta As String
On Error Resume Next
If ref_fila = "" Then


For a = 3 To 12
If Me.Controls("TextBox" & a) <> "" Then
carta = Me.Controls("TextBox" & a)
Call grabar_datos(carta)
End If
Next a


Call actualizar_grilla_registros
Call resetear
End If
End Sub


Private Sub grabar_datos(carta As String)
With Sheets("Hoja2")
rw = .Range("a1:a1000000").Find("").Row
.Cells(rw, 1) = ComboBox1
.Cells(rw, 2) = TextBox1
.Cells(rw, 3) = TextBox2
.Cells(rw, 4) = carta
.Cells(rw, Cool = Date
.Cells(rw, 7) = ComboBox1.Column(1)
End With
With Sheets("Hoja2")
Set h1 = Sheets("Hoja2")
u = .Range("e1:f1000000").Find("").Row
.Cells(u, 5) = ComboBox2
.Cells(u, 6) = TextBox13.Value
.Cells(u + 1, 5) = ComboBox3
.Cells(u + 1, 6) = TextBox14.Value
.Cells(u + 2, 5) = ComboBox4
.Cells(u + 2, 6) = TextBox15.Value
.Cells(u + 3, 5) = ComboBox5
.Cells(u + 3, 6) = TextBox16.Value
.Cells(u + 4, 5) = ComboBox6
.Cells(u + 4, 6) = TextBox17.Value
.Cells(u + 5, 5) = ComboBox7
.Cells(u + 5, 6) = TextBox18.Value
.Cells(u + 6, 5) = ComboBox8
.Cells(u + 6, 6) = TextBox19.Value
.Cells(u + 7, 5) = ComboBox9
.Cells(u + 7, 6) = TextBox20.Value
.Cells(u + 8, 5) = ComboBox10
.Cells(u + 8, 6) = TextBox21.Value
.Cells(u + 9, 5) = ComboBox11
.Cells(u + 9, 6) = TextBox22.Value
End With
End Sub


Private Sub actualizar_grilla_registros()
On Error Resume Next
ListBox1.Clear
With Sheets("Hoja2")
For a = 0 To .Range("a1000000").End(xlUp).Row - 2
ListBox1.AddItem
For b = 0 To 4
ListBox1.List(a, b) = .Cells(a + 2, b + 1)
Next b
ListBox1.List(a, 5) = .Cells(a + 2, 1).Row
Next a
End With
End Sub


Private Sub resetear()
ComboBox1 = ""
ComboBox2 = ""
ComboBox3 = ""
ComboBox4 = ""
ComboBox5 = ""
ComboBox6 = ""
ComboBox7 = ""
ComboBox8 = ""
ComboBox9 = ""
ComboBox10 = ""
ComboBox11 = ""
For a = 1 To 22
Me.Controls("TextBox" & a) = ""
Next a
buscar = ""
ref_fila = ""
ComboBox1.SetFocus
End Sub


Private Sub CommandButton2_Click() 'salir
Unload Me

End Sub

No me pude subir archivo, Gracias, espero puedan ayudarme

jhon1904

avatar
Hola alex
es necesario que subas un archivo, ahora estamos corto de espacio, pero lo puedes hacerlo utilizando mega o dropbox o cualquier nube de internet

saludos,


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

AlexGlez


Hola buenas noches, gracias por responder, he cambiado el archivo y con un nuevo código, el problema que deseo evitar ahora es que las celdas A2:D13 de la hoja Base se queden vacíos cuando las celdas E3:E13 se encuentren sin datos, dado que la primera fila de la hoja base siempre tendrá datos espero me de a entender pero no soy tan experto en esto, pero se que pueden ayudarme por favor; dejo el código que utilice y el link para descarga del archivo, gracias estaré pendiente...

Link del archivo: https://mega.nz/#!6UUjnDhS!Enq6tajdWUOlYW2cpxxfP-BChbJp8LXv0t-YrypwtXE


Codigo


Private Sub CommandButton1_Click()
Set TransRowRng = ThisWorkbook.Worksheets("Base").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow, 1).Value = Date
    .Cells(NewRow, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow, 5).Value = Sheets(1).Range("B12")
    .Cells(NewRow, 6).Value = Sheets(1).Range("D12")
    .Cells(NewRow, 7).Value = Sheets(1).Range("F12")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 1, 1).Value = Date
    .Cells(NewRow + 1, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 1, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 1, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 1, 5).Value = Sheets(1).Range("B13")
    .Cells(NewRow + 1, 6).Value = Sheets(1).Range("D13")
    .Cells(NewRow + 1, 7).Value = Sheets(1).Range("F13")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 2, 1).Value = Date
    .Cells(NewRow + 2, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 2, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 2, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 2, 5).Value = Sheets(1).Range("B14")
    .Cells(NewRow + 2, 6).Value = Sheets(1).Range("D14")
    .Cells(NewRow + 2, 7).Value = Sheets(1).Range("F14")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 3, 1).Value = Date
    .Cells(NewRow + 3, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 3, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 3, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 3, 5).Value = Sheets(1).Range("B15")
    .Cells(NewRow + 3, 6).Value = Sheets(1).Range("D15")
    .Cells(NewRow + 3, 7).Value = Sheets(1).Range("F15")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 4, 1).Value = Date
    .Cells(NewRow + 4, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 4, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 4, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 4, 5).Value = Sheets(1).Range("B16")
    .Cells(NewRow + 4, 6).Value = Sheets(1).Range("D16")
    .Cells(NewRow + 4, 7).Value = Sheets(1).Range("F16")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 5, 1).Value = Date
    .Cells(NewRow + 5, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 5, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 5, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 5, 5).Value = Sheets(1).Range("B17")
    .Cells(NewRow + 5, 6).Value = Sheets(1).Range("D17")
    .Cells(NewRow + 5, 7).Value = Sheets(1).Range("F17")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 6, 1).Value = Date
    .Cells(NewRow + 6, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 6, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 6, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 6, 5).Value = Sheets(1).Range("B18")
    .Cells(NewRow + 6, 6).Value = Sheets(1).Range("D18")
    .Cells(NewRow + 6, 7).Value = Sheets(1).Range("F18")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 7, 1).Value = Date
    .Cells(NewRow + 7, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 7, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 7, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 7, 5).Value = Sheets(1).Range("B19")
    .Cells(NewRow + 7, 6).Value = Sheets(1).Range("D19")
    .Cells(NewRow + 7, 7).Value = Sheets(1).Range("F19")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 8, 1).Value = Date
    .Cells(NewRow + 8, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 8, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 8, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 8, 5).Value = Sheets(1).Range("B19")
    .Cells(NewRow + 8, 6).Value = Sheets(1).Range("D19")
    .Cells(NewRow + 8, 7).Value = Sheets(1).Range("F19")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 9, 1).Value = Date
    .Cells(NewRow + 9, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 9, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 9, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 9, 5).Value = Sheets(1).Range("B20")
    .Cells(NewRow + 9, 6).Value = Sheets(1).Range("D20")
    .Cells(NewRow + 9, 7).Value = Sheets(1).Range("F20")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 10, 1).Value = Date
    .Cells(NewRow + 10, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 10, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 10, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 10, 5).Value = Sheets(1).Range("B21")
    .Cells(NewRow + 10, 6).Value = Sheets(1).Range("D21")
    .Cells(NewRow + 10, 7).Value = Sheets(1).Range("F21")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 11, 1).Value = Date
    .Cells(NewRow + 11, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 11, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 11, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 11, 5).Value = Sheets(1).Range("B22")
    .Cells(NewRow + 11, 6).Value = Sheets(1).Range("D22")
    .Cells(NewRow + 11, 7).Value = Sheets(1).Range("F22")
End With
With ThisWorkbook.Worksheets("Base")
    .Cells(NewRow + 12, 1).Value = Date
    .Cells(NewRow + 12, 2).Value = Sheets(1).Range("B10")
    .Cells(NewRow + 12, 3).Value = Sheets(1).Range("D10")
    .Cells(NewRow + 12, 4).Value = Sheets(1).Range("F10")
    .Cells(NewRow + 12, 5).Value = Sheets(1).Range("B23")
    .Cells(NewRow + 12, 6).Value = Sheets(1).Range("D23")
    .Cells(NewRow + 12, 7).Value = Sheets(1).Range("F23")
End With
With ActiveWorkbook.Sheets(1)
    .Range("D10").ClearContents
    .Range("F10").ClearContents
    .Range("B12:B23").ClearContents
    .Range("D12:D23").ClearContents
    .Range("F12:F23").ClearContents
End With


End Sub

jhon1904

avatar


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

AlexGlez


Muchas Gracias quedo excelente justo lo que necesitaba; felicitaciones haces un excelente trabajo ayudando a los que aun no somos expertos en esta área...

Gracias una ves mas doy el tema por resuelto

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.