Tengo un archivo de Excel y quiero leer el valor de una celda, es decir, una celda contiene (S:1 P:0 K:1 Q:1)
Quiero leer cada valor y guardar cada valor en otra columna. Por ejemplo si S:1, entonces debe ser otra celda 1, ¿cómo puedo leer los datos de una celda y escribir en otra celda con macro y vba?
Gracias por su ayuda
ACTUALIZAR:
Sub MacroF1()
usedRowCount = Worksheets("Übersicht_2013").UsedRange.Rows.Count
For i = 1 To usedRowCount
cellAYvalue = Worksheets("Übersicht_2013").Cells(i, "AY").Value
If InStr(cellvalue, "S: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BC") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BC") = 0
End If
If InStr(cellvalue, "P: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BD") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BD") = 0
End If
If InStr(cellvalue, "M: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BE") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BE") = 0
End If
If InStr(cellvalue, "L: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BF") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BF") = 0
End If
If InStr(cellvalue, "K: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BG") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BG") = 0
End If
If InStr(cellvalue, "Q: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BH") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BH") = 0
End If
'Worksheets("Übersicht_2013").Cells(i, "BC") = dd
'Worksheets("Übersicht_2013").Cells(i, "AY").Value
'Worksheets("Übersicht_2013").Range("BD44") = "Babak"
Next i
End Sub
seguramente puede hacerlo con fórmulas de hoja de cálculo, evitando VBA por completo:
así que para este valor en, digamos, la columna AV S:1 P:0 K:1 Q:1
pones esta fórmula en la columna BC:
=MID(AV:AV,FIND("S",AV:AV)+2,1)
luego estas fórmulas en las columnas BD, BE...
=MID(AV:AV,FIND("P",AV:AV)+2,1)
=MID(AV:AV,FIND("K",AV:AV)+2,1)
=MID(AV:AV,FIND("Q",AV:AV)+2,1)
entonces estas fórmulas buscan los valores S:1, P:1 etc en la columna AV. Si la función FIND
devuelve un error, entonces 0 es devuelto por la fórmula, si no 1 (como un IF, THEN, ELSE
).
A continuación, sólo tiene que copiar las fórmulas para todas las filas de la columna AV.
SALUDOS Philip
Tengo esta función para este caso ..
Function GetValue(r As Range, Tag As String) As Integer
Dim c, nRet As String
Dim n, x As Integer
Dim bNum As Boolean
c = r.Value
n = InStr(c, Tag)
For x = n + 1 To Len(c)
Select Case Mid(c, x, 1)
Case ":": bNum = True
Case " ": Exit For
Case Else: If bNum Then nRet = nRet & Mid(c, x, 1)
End Select
Next
GetValue = val(nRet)
End Function
Para llenar la celda BC .. (se supone que compruebe la celda A1)
Worksheets("Übersicht_2013").Cells(i, "BC") = GetValue(range("A1"),"S")
Los alfabetos o símbolos individuales que residen en una sola celda pueden insertarse en diferentes celdas de diferentes columnas mediante el siguiente código:
For i = 1 To Len(Cells(1, 1))
Cells(2, i) = Mid(Cells(1, 1), i, 1)
Next
Si no desea que los símbolos como dos puntos se inserte poner una condición if en el bucle.