Cálculo sobre valores de una columna si encuentra la misma fecha, el mismo nombre y coordenadas x,y,z en 3 columnas diferentes
De antemano si me pueden ayudar, muchas gracias.
Tengo un archivo en el que en una columna aparecen fechas con hora (se repiten), en otra columna me aparecen los nombres de unos instrumentos (también se repiten), en una tercera columna me aparece por cada nombre de instrumento el valor X, Y, Z para cada fecha (valor único por instrumento y fecha). Necesito poder calcular en otra columna la componente de esas coordenadas por instrumento y fecha.
Mi idea era programar macro que para cada fecha repetida en la columna uno, si se repite el instrumento en la columna 2, me haga el cálculo cogiendo la x, y, z de la tercera columna en donde las condiciones anteriores se den.
¡Cualquier idea se agradece!
H o l a:
Envíame tu archivo con un par de ejemplos, en la hoja1 me pones los datos que tienes, y en la hoja2, pones los resultados que esperas, en la hoja2, con comentarios me explicas cada ejemplo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Núria Fora” y el título de esta pregunta.
¡Gracias! Ya te envié el ejemplo. Espero se entienda.
Te anexo la macro
Sub Calcular_Componente()
'---
' Por.Dante Amor
'---
'
Dim coords As New Collection
Dim valors As New Collection
Set h1 = Sheets("Hoja1")
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("F2:F" & Rows.Count).ClearContents
With h1.Sort
.SortFields.Clear
.SortFields.Add Key:=h1.Range("B2:B" & u1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=h1.Range("D2:D" & u1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=h1.Range("E2:E" & u1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h1.Range("A1:F" & u1)
.Header = xlYes: .MatchCase = False
.Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
End With
'
ant = h1.Cells(2, "B")
an2 = h1.Cells(2, "D")
an3 = h1.Cells(2, "C")
cuenta = 0
ini = 2
fin = 2
Set coords = Nothing
Set valors = Nothing
For i = 2 To u1 + 1
If ant = h1.Cells(i, "B") And _
an2 = h1.Cells(i, "D") Then
cuenta = cuenta + 1
coords.Add h1.Cells(i, "E")
valors.Add h1.Cells(i, "C")
fin = i
Else
Select Case cuenta
Case 1
h1.Cells(ini, "F") = an3
Case 3
'Revisar letras X, Y, Z
n1 = coords(1)
n2 = coords(2)
n3 = coords(3)
If coords(1) = "(X)" And _
coords(2) = "(Y)" And _
coords(3) = "(Z)" Then
'Poner la fórmula
res = Sqr((valors(1) ^ 2) + (valors(2) ^ 2) + (valors(3) ^ 2))
h1.Range(h1.Cells(ini, "F"), h1.Cells(fin, "F")) = res
Else
h1.Cells(ini, "F") = "No tiene las 3 letras (X), (Y), (Z)"
End If
Case Else
h1.Cells(ini, "F") = "No tiene las 3 coordenadas"
End Select
ini = i
fin = i
cuenta = 1
Set coords = Nothing
Set valors = Nothing
coords.Add h1.Cells(i, "E")
valors.Add h1.Cells(i, "C")
End If
ant = h1.Cells(i, "B")
an2 = h1.Cells(i, "D")
an3 = h1.Cells(i, "C")
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias! ¡Me ha servido mucho!
He modificado algunas cosas del código que me enviaste para adaptarlo mejor a mis necesidades y funciona perfectamente. ¡Gracias!
