私はExcelファイルを持っていますが、私はセルの値を読みたいのです。例えば、あるセルには「(S:1 P:0 K:1 Q:1)`」が含まれていますが、私はそれぞれの値を読み、それぞれの値を別の列に保存したいのです。例えば、S:1であれば、別のセル1にしなければなりません。マクロとVBAを使って、セルからデータを読み取り、別のセルに書き込むにはどうすればよいでしょうか?
よろしくお願いします。
UPDATE:
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列のすべての行の計算式をコピーするだけです。
はい。 フィリップ
私はこのケースのためにこの機能を持っています。
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")