Tengo una hoja en excel dividida en dos y necesito limitar el numero de columnas, para...
Tengo una hoja en excel que se divide en dos como se observa en la figura, en una parte introduzco los datos con un formulario, que en estos momentos no me funciona, por que tengo la hoja dividida en dos, por lo que necesito aplicar en una de las partes lo siguiente para que los datos se vayan moviendo por filas en la primera parte de la hoja, en la otra parte tengo fórmulas para que se vayan copiando estos datos
Es posible limitar el numero de columnas en formularios con código :
on_Dolu_Satir = Sheets("Zuschnitte").Range("D65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Zuschnitte").Range("B" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Zuschnitte").Range("B:B")) + 1
1 Respuesta
Disculpa!
Los datos los entro a la (Zuschnitte)con el siguiente código,
Private Sub CommandButton124_Click()
pass = "chevo"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
If Me.TextBox14.Value = "" Then
Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
Exit Sub
End If
Sheets("Zuschnitte").Unprotect pass
Sheets("Stecker Buchse").Unprotect pass
Son_Dolu_Satir = Sheets("Zuschnitte").Range("D65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Zuschnitte").Range("B" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Zuschnitte").Range("B:B")) + 1
Sheets("Zuschnitte").Range("C" & Bos_Satir).Value = TextBox16.Text 'VERBINDUNG
Sheets("Zuschnitte").Range("D" & Bos_Satir).Value = TextBox2.Text 'Querschnitt
Sheets("Zuschnitte").Range("F" & Bos_Satir).Value = TextBox14.Text 'zahl
Sheets("Zuschnitte").Range("E" & Bos_Satir).Value = TextBox17.Text 'LÄNGE
'Sheets("Zuschnitte").Range("E" & Bos_Satir).Value = TextBox1
Sheets("Zuschnitte").Range("G" & Bos_Satir).Value = TextBox23.Text 'ISOLATION
Son_Dolu_Satir = Sheets("Stecker Buchse").Range("D65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Stecker Buchse").Range("B" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Stecker Buchse").Range("B:B")) + 1
If TextBox16 = "ZWL" Then
Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = ""
ElseIf TextBox16 = "ZWL Si" Then
Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
Else: Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = TextBox16.Text 'VERBINDUNG
Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = TextBox14.Text '
Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = TextBox2.Text '
Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = TextBox17.Text 'gte zahl
End If
Call Main 'PROGRESS BAR
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Sheets("Zuschnitte").Protect
End SubEn la hoja Stecker-Buchse esalgo parecido
Ahora explica con un simple ejemplo, cuándo debe pegar en lado izquierdo de la hoja y cuándo en el lado derecho.
O comparte tu archivo en google drive y en la hoja me explicas con detalle qué necesitas.
Te pido la explicación, porque no entiendo realmente qué quieres.
Te he enviado el libro es el mismo que te envíe anteriormente pero hice una modificación a las hojas de excel pues las otras están fuera de norma, una la otra mitad de la hoja tienen fórmulas para copiar los datos de la hoja que se entran los datos por un formulario, esta hoja debe actualizarse también
Eusebio
He limitado el libro Zuschnitte en el rango a1:H45 con el siguiente modulo que vez abajo, pero no entran los datos en la hoja al apretar el botón
Private Sub auto_open() Dim f1 As Integer Dim f2 As Integer Dim c1 As Integer Dim c2 As Integer ' With Zuschnitte With Windows(1).VisibleRange f1 = .Row f2 = f1 + .EntireRow.Count - 2 ' c1 = .Column c2 = c1 + .EntireColumn.Count - 2 End With ' Range(Cells(f1, c1), Cells(f2, c2)).Select .ScrollArea = .ScrollArea = Range(Cells(f1, c1), Cells(f2, c2)).Address End With End Sub
Disculpa Dante se ha metido el Bruto en la cabeza, Heborrado las fórmulas del lado derecho, pero los datos en la parte derecha se empiezan a grabar a partir de la fila 45 como es observa en la figura y realmente no encuentro la causa, podrías por favor echarle un vistazo a ver por que me pasa eso-
Gracias y de nuevo disculpa y Gracias
Eusebio
Haber si entendí.
Según tu pregunta inicial, vas a agregar datos a la hoja "Zuschnitte", con el userform9, cuando presionas el botón "CommandButton124"
Actualicé el código para agregar registros a la hoja "Zuschnitte"
'Actualizar hoja Zuschnitte y Stecker Buchse
Private Sub CommandButton124_Click()
'DECLARAR VARIABLES
Dim pass As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, n As Long
'
'AMBIENTE
Application.ScreenUpdating = False
'
'DATOS INICIALES
pass = "chevo"
If Me.TextBox14.Value = "" Then
Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
Exit Sub
End If
Set sh1 = Sheets("Zuschnitte")
Set sh2 = Sheets("Stecker Buchse")
i = 7 'fila inicial
n = 0
Do While sh1.Range("B" & i).Value <> ""
n = sh1.Range("B" & i).Value + 1
i = i + 1
Loop
'ACTUALIZAR hoja Zuschnitte
sh1.Unprotect pass
sh1.Range("B" & i).Value = n
sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
sh1.Range("F" & i).Value = TextBox14.Text
sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
sh1.Protect pass
'
' Sheets("Stecker Buchse").Range("B" & Bos_Satir).Value = _
' Application.WorksheetFunction.Max(Sheets("Stecker Buchse").Range("B:B")) + 1
' If TextBox16 = "ZWL" Then
' Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = ""
' ElseIf TextBox16 = "ZWL Si" Then
' Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
' Else: Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = TextBox16.Text 'VERBINDUNG
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = TextBox14.Text '
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = TextBox2.Text '
' Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = TextBox17.Text 'gte zahl
' End If
' Call Main 'PROGRESS BAR
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True
End SubMe faltó actualizar la hoja "Stecker Buchse" porque no entendí qué vas a hacer, pero empieza a probar la parte que agrega registros a la hoja "Zuschnitte".
Yo me pase días con dolor de cabeza, sin encontrar la solución. Gracias, existe un pequeño problema y es en la numeración de la hoja
Eusebio
En la hoja Stecker Buchse van los mismos elementos excepto ""ZWL" Y ""ZWLi" es por eso que he utilizado la función If
Para el problema de la numeración.
Cambia esta línea:
n = 0
Por esta:
N = 1
Corrige manualmente toda la numeración y vuelve a ejecutar tu formulario para que tome los nuevos valores.
Del lado izquierdo de la hoja, también tienes fórmulas, bórralas.
Nota stecker buchse se imprime on el botón 121 este botón esta oculto pero aparece bajo algunas condiciones
error en la hoja stecker buchse
Ya se corrigieron pero los numero no se anorden
se me me borro el encabezado de la tabla
No entiendo esta parte.
' Sheets("Stecker Buchse").Range("B" & Bos_Satir).Value = _
' Application.WorksheetFunction.Max(Sheets("Stecker Buchse").Range("B:B")) + 1
' If TextBox16 = "ZWL" Then
' Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = ""
' ElseIf TextBox16 = "ZWL Si" Then
' Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = ""
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = ""
' Else: Sheets("Stecker Buchse").Range("C" & Bos_Satir).Value = TextBox16.Text 'VERBINDUNG
' Sheets("Stecker Buchse").Range("F" & Bos_Satir).Value = TextBox14.Text '
' Sheets("Stecker Buchse").Range("D" & Bos_Satir).Value = TextBox2.Text '
' Sheets("Stecker Buchse").Range("E" & Bos_Satir).Value = TextBox17.Text 'gte zahl
' End IfPodrías crear otra pregunta y lo intentas explicar con mayor detalles.
Olvídate del código, explica con gran detalle utilizando tus palabras, qué quieres hacer.
Paso a paso, no te limites con la explicación. Utiliza tu formulario e imagina que lo estás llenados con datos, esos datos los pones en la explicación, imagina que quieres poner los datos en la hoja "Secker Buchse". En cuál fila los quieres poner y por qué. Todo eso que imaginas lo explicas con detalle.
¡Gracias! OK! Dejame hacer algo y te novio otras preguntas
Un millón de gracias
Eusebio
Observa como no arace ningún dato con ZWL a pesar de que lo he marcado y salvado
Oldiva todo lo que hemos hecho hasta ahora y mira esto, he puesto tu código en le botón schnen la hoja Zuschnitte y funciona:
Código:
Private Sub CommandButton110_Click()
'Actualizar hoja Zuschnitte y Stecker Buchse
'DECLARAR VARIABLES
Dim pass As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, n As Long
'
'AMBIENTE
Application.ScreenUpdating = False
'
'DATOS INICIALES
pass = "chevo"
If Me.TextBox14.Value = "" Then
Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
Exit Sub
End If
Set sh1 = Sheets("Zuschnitte")
Set sh2 = Sheets("Stecker Buchse")
i = 7 'fila inicial
n = 0
Do While sh1.Range("B" & i).Value <> ""
n = sh1.Range("B" & i).Value + 1
i = i + 1
Loop
'ACTUALIZAR hoja Zuschnitte
sh1.Unprotect pass
sh1.Range("B" & i).Value = n
sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
sh1.Range("F" & i).Value = TextBox14.Text
sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
sh1.Protect pass
'
Call Main 'PROGRESS BAR
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
sh1.Protect
End Suby en la hoja zuschnitte sale lo siguiente y estoy contento:
He realizado modificaciones en la hoja stecker buchse tu código mira:
Pero la hoja no se me actualiza alfabéticamente: Resolviendo esto ya no necesito más nada
Actualizar hoja Zuschnitte y Stecker Buchse
Private Sub CommandButton124_Click()
'DECLARAR VARIABLES
Dim pass As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, n As Long
'
'AMBIENTE
Application.ScreenUpdating = False
'
'DATOS INICIALES
pass = "chevo"
If Me.TextBox14.Value = "" Then
Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
Exit Sub
End If
Set sh1 = Sheets("Zuschnitte")
Set sh2 = Sheets("Stecker Buchse")
i = 7 'fila inicial
n = 1
no = i = i + 1
Do While sh1.Range("B" & i).Value <> ""
n = sh1.Range("B" & i).Value + 1
i = i + 1
Loop
Do While sh2.Range("B" & i).Value <> ""
no = sh1.Range("B" & i).Value + 1
i = i + 1
Loop
'ACTUALIZAR hoja Zuschnitte
sh1.Unprotect pass
sh1.Range("B" & i).Value = n
sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
sh1.Range("F" & i).Value = TextBox14.Text
sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
sh1.Protect pass
'
'Sheets("Stecker Buchse").Range("B" & Bos_Satir).Value = _
'Application.WorksheetFunction.Max(Sheets("Stecker Buchse").Range("B:B")) + 1
If TextBox16 = "ZWL" Then
sh2.Range("C" & i).Value = ""
sh2.Range("F" & i).Value = ""
sh2.Range("D" & i).Value = ""
sh2.Range("E" & i).Value = ""
ElseIf TextBox16 = "ZWL Si" Then
sh2.Range("C" & i).Value = ""
sh2.Range("F" & i).Value = ""
sh2.Range("D" & i).Value = ""
Else: sh2.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh2.Range("F" & i).Value = TextBox14.Text '
sh2.Range("D" & i).Value = TextBox2.Text '
sh2.Range("E" & i).Value = TextBox17.Text 'gte zahl
End If
Call Main 'PROGRESS BAR
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
Application.ScreenUpdating = True
End Sub
Ya sé cuál es el problema que tienen tus hojas para ordenar.
Tienes creadas las tablas: "Zuschnitt" y "Stecker" convierte esas tablas en rango de datos y problema solucionado.
Te anexo el código actualizado con la línea para ordenar.
'Actualizar hoja Zuschnitte y Stecker Buchse
Private Sub CommandButton124_Click()
'DECLARAR VARIABLES
Dim pass As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, n As Long
'
'AMBIENTE
Application.ScreenUpdating = False
'
'DATOS INICIALES
pass = "chevo"
If Me.TextBox14.Value = "" Then
Call MsgBox("Diese Länge würde schon berechnet", vbInformation, "nicht speichern ")
Exit Sub
End If
Set sh1 = Sheets("Zuschnitte")
Set sh2 = Sheets("Stecker Buchse")
'
i = 7 'fila inicial
n = 1
Do While sh1.Range("B" & i).Value <> ""
n = sh1.Range("B" & i).Value + 1
i = i + 1
Loop
'ACTUALIZAR hoja Zuschnitte
sh1.Unprotect pass
sh1.Range("B" & i).Value = n
sh1.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh1.Range("D" & i).Value = TextBox2.Text 'Querschnitt
sh1.Range("E" & i).Value = TextBox17.Text 'LÄNGE
sh1.Range("F" & i).Value = TextBox14.Text
sh1.Range("G" & i).Value = TextBox23.Text 'ISOLATION
sh1.Protect pass
'
i = 7 'fila inicial
n = 1
Do While sh2.Range("B" & i).Value <> ""
n = sh2.Range("B" & i).Value + 1
i = i + 1
Loop
sh2.Unprotect pass
sh2.Range("B" & i).Value = n
If TextBox16 = "ZWL" Then
sh2.Range("C" & i).Value = ""
sh2.Range("F" & i).Value = ""
sh2.Range("D" & i).Value = ""
sh2.Range("E" & i).Value = ""
ElseIf TextBox16 = "ZWL Si" Then
sh2.Range("C" & i).Value = ""
sh2.Range("F" & i).Value = ""
sh2.Range("D" & i).Value = ""
Else: sh2.Range("C" & i).Value = TextBox16.Text 'VERBINDUNG
sh2.Range("F" & i).Value = TextBox14.Text '
sh2.Range("D" & i).Value = TextBox2.Text '
sh2.Range("E" & i).Value = TextBox17.Text 'gte zahl
End If
'Para ordenar
sh2.Range("C6:G37").Sort key1:=sh2.Range("C6"), order1:=xlAscending, Header:=xlYes
sh2.Protect pass
Call Main 'PROGRESS BAR
Application.ScreenUpdating = True
MsgBox "Die Daten wurden gespeichert", vbApplicationModal, ""
End Sub
¡Gracias! Genio un millón de Gracias, hace más de una semana luchando con esto. Lo de la numeración orenada no están importante, lo puedo eliminar.
Cuidate
Eusebio
