在Excel vba中读取单元格值并写入另一个单元格
我有一个Excel文件，我想读取一个单元格的值，即单元格包含(S:1 P:0 K:1 Q:1)我想读取每个值并将每个值保存到另一列。 例如，如果S：1，那么应该是另一个单元格1，我怎样才能读取单元格的数据，并写入另一个单元格与macros和VBA？
感谢您的帮助
更新：
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
当然你可以用工作表公式来完成，避免使用VBA：
所以对于这个值，在列AV S：1 P：0 K：1 Q：1
你把这个公式放在BC列中：
=MID(AV:AV,FIND("S",AV:AV)+2,1)
那么这些公式在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)
所以这些公式在列AV中寻找值S：1 ， P：1等。 如果FIND函数返回错误，则公式返回0，否则返回1（如IF, THEN, ELSE
那么你只需要复制AV列中所有行的公式。
HTH Philip
驻留在单个单元格中的单个字母或符号可以通过以下代码插入到不同列中的不同单元格中：
For i = 1 To Len(Cells(1, 1)) Cells(2, i) = Mid(Cells(1, 1), i, 1) Next
如果你不希望像冒号这样的符号被插入，则在循环中放入if条件。
我有这个function的情况下..
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
填充单元格BC（假设您检查单元格A1）
Worksheets("Übersicht_2013").Cells(i, "BC") = GetValue(range("A1"),"S")