Bir Excel dosyam var ve bir hücrenin değerini okumak istiyorum, yani bir hücre (S:1 P:0 K:1 Q:1)
içeriyor, her değeri okumak ve her değeri başka bir sütuna kaydetmek istiyorum. Örneğin S:1 ise, o zaman başka bir hücre 1 olmalıdır, makro ve vba ile bir hücreden verileri nasıl okuyabilir ve başka bir hücreye nasıl yazabilirim?
Yardımlarınız için teşekkür ederiz
GÜNCELLEME:
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
Elbette bunu VBA'dan tamamen kaçınarak çalışma sayfası formülleriyle yapabilirsiniz:
Bu nedenle, örneğin AV sütunundaki bu değer için S:1 P:0 K:1 Q:1
bu formülü BC sütununa koyarsınız:
=MID(AV:AV,FIND("S",AV:AV)+2,1)
sonra BD, BE... sütunlarındaki bu formüller
=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)
dolayısıyla bu formüller AV sütununda S:1, P:1 vb. değerleri arar. Eğer FIND
fonksiyonu bir hata döndürürse, formül tarafından 0 döndürülür, aksi takdirde 1 (bir IF, THEN, ELSE
gibi)
Daha sonra AV sütunundaki tüm satırlar için formülleri kopyalamanız yeterli olacaktır.
HTH Philip
Bu durum için bu fonksiyona sahibim.
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 hücresini doldurmak için ... (A1 hücresini kontrol ettiğiniz varsayılır)
Worksheets("Übersicht_2013").Cells(i, "BC") = GetValue(range("A1"),"S")
Tek bir hücrede bulunan alfabe veya semboller, aşağıdaki kodla farklı sütunlardaki farklı hücrelere eklenebilir:
For i = 1 To Len(Cells(1, 1))
Cells(2, i) = Mid(Cells(1, 1), i, 1)
Next
İki nokta üst üste gibi sembollerin eklenmesini istemiyorsanız, döngüye bir if koşulu koyun.