Membaca nilai sel di Excel vba dan menulis di Sel lain

Saya memiliki file Excel dan saya ingin membaca nilai sel yaitu sel berisi (S:1 P:0 K:1 Q:1) Saya ingin membaca setiap nilai dan menyimpan setiap nilai ke kolom lain. Misalnya jika S: 1, maka harus sel lain 1, bagaimana saya bisa membaca data dari sel dan menulis di sel lain dengan makro dan vba?

Terima kasih atas bantuannya

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
Community
Pertanyaan edit 9 Juli 2018 в 6:41
Pemrograman
vba excel excel-vba
2 Juli 2013 в 8:56
34 tayangan
Larutan

tentunya Anda dapat melakukan ini dengan rumus lembar kerja, menghindari VBA sepenuhnya:

jadi untuk nilai ini, katakanlah, kolom AV S:1 P:0 K:1 Q:1

Anda meletakkan rumus ini di kolom BC:

=MID(AV:AV,FIND("S",AV:AV)+2,1)

lalu rumus ini di kolom 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)

jadi rumus-rumus ini mencari nilai S:1, P:1 dll di kolom AV. Jika fungsi FIND mengembalikan kesalahan, maka 0 dikembalikan oleh rumus, jika tidak 1 (seperti IF, THEN, ELSE

Kemudian Anda hanya akan menyalin rumus untuk semua baris di kolom AV.

HTH Philip

Our Man in Bananas
Jawaban edit 3 Juli 2013 в 3:47
Komentar (3)

Saya memiliki fungsi ini untuk kasus ini ...

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

Untuk mengisi sel BC .. (diasumsikan bahwa Anda memeriksa sel A1)

Worksheets("Übersicht_2013").Cells(i, "BC") = GetValue(range("A1"),"S")
matzone
Jawaban edit 2 Juli 2013 в 11:57
Komentar (0)

Huruf atau simbol individual yang berada dalam satu sel dapat disisipkan ke dalam sel yang berbeda dalam kolom yang berbeda dengan kode berikut:

For i = 1 To Len(Cells(1, 1))
Cells(2, i) = Mid(Cells(1, 1), i, 1)
Next

Jika Anda tidak ingin simbol seperti titik dua disisipkan, letakkan kondisi if dalam loop.

Komentar (0)